Save Outlook Attachment to Folder on PC using Excel VBA - excel

Question

I am trying to save attachments from a sub-folder in Outlook to a folder on my C drive using Excel VBA.
For example, in my inbox folder I have a sub-folder called 'data' and in this folder there are emails with different excel attachments of different data but with the same formatting and the same attachment name but with an updated date (Eg: "Attachment name + 28 March").
These emails are sent daily. I want all attachments, not already saved, saved to a folder on my C drive and then open each attachment to extract the relevant data to Excel.
I am able to extract the relevant data once the files are in my C drive but I am unable to set up a path from my Excel to Outlook without Outlook VBA (which I don't want to do).
This is what I have so far: (the comments are for my benefit because I am new to this)
Sub attachmentsave()
Dim olook As Outlook.Application
Dim omailitem As Outlook.mailitem
'whenever dealing with folders we need to define outlook.namespace This is a class that opens the gate for me to access all outlook folders
Dim onamespace As Outlook.Namespace
Dim fol As Outlook.Folder 'we need to tell vba where we have out emails with attachments stored
Dim atmt As Outlook.Attachment '.attachment is a class that will help us deal with emails that have attachments
Set olook = New Outlook.Application
Set omailitem = olook.CreateItem(olmailitem)
'messaging application protocol interface
Set onamespace = olook.GetNameSpace("MAPI")
Set fol = onamespace.GetDefaultFolder(olFolderInbox)
For Each omailitem In fol.items
For Each atmt In omailitem.attachments
atmt.SaveAsFile "C:/" & atmt.FileName
'all attachments in inbox should be save in C drive
Next
Next
End Sub

Answer 1

You need a macro-enabled Excel workbook with a reference to "Microsoft Output nn.n Object Library" where “nn.n” depends on the version of Office you are running. Please do not mix versions; I have never tried but I understand it causes problems.
I am assuming you are familiar with Excel VBA and know how to create a macro-enabled workbook. From your comments, I assume you do not know about references.
Much of the power of VBA is not native but comes from libraries which you can reference if you need their functionality. Open the VBA Editor and click Tools and then References. You will get a long list of available references. Those at the top will be ticked. For example, "Microsoft Excel nn.n Object Library" will be ticked. Without this reference, the compiler would not know what a range or a worksheet was. Note: "nn.n" depends on the version of Office you are using. For me, the value is "16.0" because I am using Office 365.
Unticked references are in alphabetic sequence. Scroll down the list until you find "Microsoft Outlook nn.n Object Library". Click the box to the left to tick this reference. Click "OK". If you click Tools then References again you will see "Microsoft Outlook nn.n Object Library" ticked and near the top. The compiler now has access to the definitions of MailItem, Folder and the rest of the Outlook Object Model.
Copy the code below to a new module:
Option Explicit
Sub ListStores()
' Needs reference to "Microsoft Output nn.n Object Library"
' where "nn.n" depends on the version of Outlook you are using.
Dim AppOut As New Outlook.Application
Dim InxStoreCrnt As Long
Dim FldrInbox As Outlook.Folder
With AppOut
With .Session
Debug.Print "List of stores:"
For InxStoreCrnt = 1 To .Folders.Count
Debug.Print " " & .Folders(InxStoreCrnt).Name
Next
Set FldrInbox = .GetDefaultFolder(olFolderInbox)
Debug.Print "Store for default Inbox: " & FldrInbox.Parent.Name
End With
End With
AppOut.Quit
Set AppOut = Nothing
End Sub
VBA usually has more than one method of achieving a desired effect. You have used “NameSpace” in your code whilst I have used “Session”. The documentation says these two methods are equivalent. If you write your own code, you can pick whichever method you prefer. But if you go looking for useful snippets, you must be ready for other people having different preferences.
Dim AppOut As New Outlook.Application creates an instance of Outlook that will access Outlook’s files on behalf of the macro.
With AppOut
With .Session
: : : :
End With
End With
I can replace : : : : with any Outlook VBA. If an Excel macro tries to access an email, the user will be warned and asked to give permission for the macro to run.
Outlook keeps emails, appointments, tasks and so on in files it calls Stores. You may see these called PST files because most have an extension of PST but an OST file is also a store. You may see them called Accounts because, by default, Outlook creates one store per email account. However, you can create as many extra stores as you want, none of which will be Accounts.
This code will create a list of the stores you can access:
Debug.Print "List of stores:"
For InxStoreCrnt = 1 To .Folders.Count
Debug.Print " " & .Folders(InxStoreCrnt).Name
Next
The output might look something like:
List of stores:
Outlook Data File
Smith John#ISPOne.com
Archive Folders
Backup
John Smith#ISPTwo.com
OutlookOutlook
The above is based on my home installation. A work installation is likely to be somewhat different. The differences will depend on the options chosen during installation. A work installation is also likely to included shared folders which I do not have on my system.
If you look at your folder pane, you will have names with other names indented underneath. The names be will the stores and will match the stores listed by the macro although the sequence will probably be different. The other names in the folder pane will be the folders within each store.
The last bit of my macro is:
Set FldrInbox = .GetDefaultFolder(olFolderInbox)
Debug.Print "Store for default Inbox: " & FldrInbox.Parent.Name
You have similar code to access an Inbox but this may not be the Inbox you want. On my system, this code outputs:
Store for default Inbox: Outlook Data File
“Outlook Data File” is Outlook’s default store. On my system, the calendar and my tasks are held in this store but my emails are not. I have two email accounts and each has their own store.
Try this above macro. Does GetDefaultFolderfind the Inbox you need to access?
Now add this macro:
Sub ListStoresAndFirstEmails()
' Needs reference to "Microsoft Output nn.n Object Library"
' where "nn.n" depends on the version of Outlook you are using.
Dim AppOut As New Outlook.Application
Dim InxFldrCrnt As Long
Dim InxStoreCrnt As Long
Dim FldrInbox As Outlook.Folder
With AppOut
With .Session
Debug.Print "List of stores and first emails:"
For InxStoreCrnt = 1 To .Folders.Count
Debug.Print " " & .Folders(InxStoreCrnt).Name
For InxFldrCrnt = 1 To .Folders(InxStoreCrnt).Folders.Count
If .Folders(InxStoreCrnt).Folders(InxFldrCrnt).Name = "Inbox" Then
Set FldrInbox = .Folders(InxStoreCrnt).Folders(InxFldrCrnt)
If FldrInbox.Items.Count > 0 Then
With FldrInbox.Items(1)
Debug.Print " Subject: " & .Subject
Debug.Print " Received: " & .ReceivedTime
Debug.Print " From: " & .SenderEmailAddress
End With
End If
Exit For
End If
Next
Next
End With
End With
AppOut.Quit
Set AppOut = Nothing
End Sub
This macro is also about investigating your stores. The macro scans down your stores. For each store, it scans down the list of level 1 folders looking for "Inbox". If it finds "Inbox", it assumes the oldest item in it is a MailItem and outputs its subject, received time and sender. If the oldest item is not a MailItem, you will get an error. I almost hope you do get an error to demonstrate the importance of not making assumptions.
Finally add:
Sub ListAttachments()
Dim AppOut As New Outlook.Application
Dim InxAttachCrnt As Long
Dim InxItemCrnt As Long
Dim InxStoreCrnt As Long
Dim FldrData As Outlook.Folder
With AppOut
With .Session
Set FldrData = .Folders("Outlook Data File").Folders("Inbox").Folders("Data")
End With
End With
Debug.Print "List emails with attachments within: ";
Debug.Print " " & FldrData.Name & " of " & FldrData.Parent.Name & _
" of " & FldrData.Parent.Parent.Name
With FldrData
For InxItemCrnt = 1 To FldrData.Items.Count
If .Items(InxItemCrnt).Class = olMail Then
With .Items(InxItemCrnt)
If .Attachments.Count > 0 Then
Debug.Print " Subject: " & .Subject
Debug.Print " Received: " & .ReceivedTime
Debug.Print " From: " & .SenderEmailAddress
For InxAttachCrnt = 1 To .Attachments.Count
Debug.Print " " & InxAttachCrnt & " " & .Attachments(InxAttachCrnt).DisplayName
Next
End If
End With
End If
Next
End With
AppOut.Quit
Set AppOut = Nothing
End Sub
I always keep some junk emails in store "Outlook Data File" for testing purposes.
In Set FldrData = .Folders("Outlook Data File").Folders("Inbox").Folders("Data") you need to replace "Outlook Data File" with the name of the store containing the emails of interest. If I understand correctly, the emails are in folder "Data" under folder "Inbox". If I have misunderstood, notice how I have used a chain of "Folders(xxxx)" to reach the required folder. In earlier emails I have used indices to reach stores and folders. Here I have specified a specific folder.
Within that folder I look for MailItems (showing how to avoid other items) and if they have attachments, list some properties of the email and the names of its attachments.
This is as far as I can go because I do not fully understand your explanation of how attachments are named or where you want attachments saved.