Outlook Macro - VBA

[isid...@gmail.com]

hi, 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?

[McKilty]

On Monday, July 14, 2014 2:31:53 PM UTC-4, isid...@gmail.com wrote:
> hi, 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