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
精彩评论