Post by i***@gmail.comhi, have an outlook macro that saved all attachments from certain emails into a local shared drive. However the macro only saves down only the first attachment if the email has multiple attachments. What can i do?
I created this a couple of years ago. You should be able to draw what you need from it.
Public Sub SaveAllAttachments()
'This macro will save all attachments of all selected emails to C:\OutlookAttachments (the folder will be created if it does not exist).
'If the filename already exists, a suffix of "_File##" will be added.
'Created by Rick Bray
'Created 4/10/12
Dim myOutlook As Outlook.Application
Dim myMailItem As Outlook.MailItem
Dim myNameSpace As Outlook.NameSpace
Dim iSelection As Integer
Dim iAttachment As Integer
Dim sFilename As String
Dim iCount As Integer
Dim bFileSaved As Boolean
If Outlook.ActiveExplorer.Selection.Count > 0 Then
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
'Check and/or Make Directory
If Dir("C:\OutlookAttachments\", vbDirectory) = "" Then
MkDir "C:\OutlookAttachments\"
End If
For iSelection = 1 To Outlook.ActiveExplorer.Selection.Count
Set myMailItem = Outlook.ActiveExplorer.Selection.Item(iSelection)
If myMailItem.Attachments.Count > 0 Then
'Loop Attachments
For iAttachment = 1 To myMailItem.Attachments.Count
sFilename = "C:\OutlookAttachments\" & myMailItem.Attachments.Item(iAttachment).fileName
iCount = 0
bFileSaved = False
Do Until bFileSaved = True
If Dir(sFilename) = "" Then
myMailItem.Attachments.Item(iAttachment).SaveAsFile sFilename
bFileSaved = True
Else
iCount = iCount + 1
sFilename = myMailItem.Attachments.Item(iAttachment).fileName
sFilename = "C:\OutlookAttachments\" & Left(sFilename, InStrRev(sFilename, ".") - 1) & "_File" & Format(iCount, "00") & Mid(sFilename, InStrRev(sFilename, "."))
End If
Loop
Next iAttachment
End If
Next iSelection
End If
End Sub