开发者

Extract msg attachments from outlook email

I have the following vba code that saves attachments in an email.

This works fine for .docx, .jpg etc but I need to use it to extract multiple .msg attachments which doesn't work.

The code is

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim save开发者_开发技巧Folder As String

saveFolder = "C:\Test\"
For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
JumpHere:
If Dir(stFileName) = "" Then
objAtt.SaveAsFile stFileName
Else
i = i + 1
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
GoTo JumpHere
End If
Set objAtt = Nothing
Next
End Sub

The error concerns the line - If Dir(stFileName) = "" Then


Following our chat, here is the final code :

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
Dim i As Integer 

saveFolder = "C:\Test\" 
For Each objAtt In itm.Attachments 
  stFileName = saveFolder & objAtt.FileName 
  i = 0 
  'Loop to find the first available filename 
  Do While Dir(stFileName) <> "" 
    i = i + 1 
    stFileName = saveFolder & i & " - " & objAtt.FileName 
  Loop
  objAtt.SaveAsFile stFileName 
Next 
End Sub

Regards,

Max

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜