How to automatically save attachments from Outlook?

Question

I am trying to automatically save all attachments from emails with a certain subject line to a folder. I have tried implementing multiple solutions from other questions on SO and other sources but they don't work. I'm generally trying to follow the process outlined here: https://windowsreport.com/outlook-rule-download-attachments/

I have the below script in the VBA editor.

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String

sSaveFolder = "H:\temp\_nre_POs\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Set oAttachment = Nothing
Next
End Sub

I have also created the rule below to handle to subject line. The rule moving emails to the _Invoices folder has been in place and working fine for months, I just added the 'Run Script' option. I don't get any errors when running the rule on existing emails in the inbox, but I also don't have any attachments showing up in the destination folder. Ideally this should run in the background, but I'm open to a more manual process. Pic of outlook rule

EDIT: I eventually got this to work using the script below. It may be a bit messy but it works.


Public Sub Application_Startup()

Dim MItem As MailItem
Dim oAttachment As Attachment
Dim sSaveFolder As String
Dim oDefInbox As Folder
Dim targetFolder As Folder
Dim myItems As Outlook.Items
Dim Item As Object

Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)
Set targetFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("_Invoices")

sSaveFolder = "H:\temp\_nre_POs"
For Each MItem In targetFolder.Items
    If MItem.UnRead = True Then
        For Each oAttachment In MItem.Attachments
            oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
            Set oAttachment = Nothing
        Next oAttachment
        MItem.UnRead = False
    End If
Next MItem

End Sub

score 0 · Answer 1 · answered Feb 22 '21 at 18:41

0

You can use event Application_NewMail in ThisOutlookSession module, that "occurs when one or more new email messages are received in the Inbox":

Private Sub Application_NewMail()
    Set myOlApp = GetObject(, "Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItem = myFolder.Items(1)
    SaveAttachmentsToDisk myItem
End Sub

answered Feb 22 '21 at 18:41

Алексей Р

7,507
2
7
18

Thank you, where would I insert the destination folder for attachments to be saved in? – SQLSqirrel Feb 22 '21 at 21:02
It is already specified in the SaveAttachmentsToDisk procedure you provided: sSaveFolder = "H: \ temp \ _nre_POs \" – Алексей Р Feb 23 '21 at 03:16

score 0 · Answer 2 · answered Feb 22 '21 at 23:23

0

In this situation rules are buggy. Remove the move from the rule. Put the move action in the code.

Option Explicit

Public Sub SaveAttachmentsToDisk(MItem As MailItem)

Dim oAttachment As Attachment
Dim sSaveFolder As String
Dim oDefInbox As folder
Dim targetFolder As folder

sSaveFolder = "H:\temp\_nre_POs\"
For Each oAttachment In MItem.Attachments
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    Set oAttachment = Nothing
Next

Set oDefInbox = Session.GetDefaultFolder(olFolderInbox)

' where the Invoices folder is directly below the Inbox
Set targetFolder = oDefInbox.folders("Invoices")

' If Invoices is nested deeper - https://stackoverflow.com/a/48916736/1571407
'  in https://stackoverflow.com/questions/8322432/using-visual-basic-to-access-subfolder-in-inbox

MItem.Move targetFolder

End Sub

answered Feb 22 '21 at 23:23

niton

8,771
21
32
52

I have tried to implement this solution but keep running into the same issue. When I assign just this script to a rule and run it in my inbox (I choose the option to access rules on server rather than client, if that matters), it seems to execute but I don't see any attachments in the destination folder. I also don't have the option to run the script from the editor. When I hit the "Run" button it just brings up the box to select macro, and doesn't show SaveAttachmentsToDisk. Could this be something in my settings? – SQLSqirrel Feb 25 '21 at 18:06
@SQLSqirrel `SaveAttachmentsToDisk` cannot run independently. You have to pass `MItem` into the code. https://stackoverflow.com/a/58049467/1571407 – niton Feb 26 '21 at 00:12

How to automatically save attachments from Outlook?

2 Answers2