I can't seem to figure out however how I can read back the subject line as I need the filename to be as below. How could I get the subject of each email as I loop through to get the attachments?:
Sub SaveAttachmentsToFolder()' This Outlook macro checks a named subfolder in the Outlook Inbox' (here the "Sales Reports" folder) for messages with attached' files of a specific type (here file with an "xls" extension)' and saves them to disk. Saved files are timestamped. The user' can choose to view the saved files in Windows Explorer.' NOTE: make sure the specified subfolder and save folder exist' before running the macro. On Error GoTo SaveAttachmentsToFolder_err' Declare variables Dim ns As NameSpace Dim inbox As MAPIFolder Dim SubFolder As MAPIFolder Dim Item As Object Dim Atmt As Attachment Dim FileName As String Dim i As Integer Dim varResponse As VbMsgBoxResult Set ns = GetNamespace("MAPI") Set inbox = ns.GetDefaultFolder(olFolderInbox) Set SubFolder = inbox.Folders("WhatsUp") ' Enter correct subfolder name. i = 0' Check subfolder for messages and exit of none found If SubFolder.Items.Count = 0 Then MsgBox "There are no messages in the Sales Reports folder.", vbInformation, _ "Nothing Found" Exit Sub End If' Check each message for attachments For Each Item In SubFolder.Items For Each Atmt In Item.Attachments' Check filename of each attachment and save if it has "xls" extension If Right(Atmt.FileName, 3) = "pdf" Then ' This path must exist! Change folder name as necessary. FileName = "C:\test\" & _ Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName Atmt.SaveAsFile FileName i = i + 1 End If Next Atmt Next Item' Show summary message If i > 0 Then varResponse = MsgBox("I found " & i & " attached files." _ & vbCrLf & "I have saved them into the C:\Email Attachments folder." _ & vbCrLf & vbCrLf & "Would you like to view the files now?" _ , vbQuestion + vbYesNo, "Finished!")' Open Windows Explorer to display saved files if user chooses If varResponse = vbYes Then Shell "Explorer.exe /e,C:\Email Attachments", vbNormalFocus End If Else MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!" End If' Clear memorySaveAttachmentsToFolder_exit: Set Atmt = Nothing Set Item = Nothing Set ns = Nothing Exit Sub' Handle ErrorsSaveAttachmentsToFolder_err: MsgBox "An unexpected error has occurred." _ & vbCrLf & "Please note and report the following information." _ & vbCrLf & "Macro Name: GetAttachments" _ & vbCrLf & "Error Number: " & Err.Number _ & vbCrLf & "Error Description: " & Err.Description _ , vbCritical, "Error!" Resume SaveAttachmentsToFolder_exitEnd Sub
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst