We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Sub SaveOutlookAttachments(olkMessage As Outlook.MailItem) Dim olkAttachment As Outlook.Attachment, _ objFSO As Object, _ strRootFolderPath As String, _ strFilename As String 'Path for where to save attachments strRootFolderPath = "X:\sh_fox\FIR_TBT\2011\2011_ExceptionReports\2011_March\3-7-2011\" Set objFSO = CreateObject("Scripting.FileSystemObject") Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder If olkMessage.Attachments.Count > 0 Then For Each olkAttachment In olkMessage.Attachments strFilename = olkAttachment.FileName intCount = 0 Do While True If objFSO.FileExists(strRootFolderPath & strFilename) Then intCount = intCount + 1 strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName Else Exit Do End If Loop olkAttachment.SaveAsFile strRootFolderPath & strFilename Next End If Set objFSO = Nothing Set olkAttachment = Nothing Set olkMessage = Nothing End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.