0

I came up with this to create an event listener for new emails to download attachments.

I combined How do I trigger a macro to run after a new mail is received in Outlook? with https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html

I cannot create a rule with macros in Outlook and I am unable to edit the registry on my current computer, so I need a workaround.

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    ' default local Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
        Dim strSubject As String
        strSubject = Msg.Subject
        If InStr(0, strSubject, "VBA Test") > 0 Then
            Dim oAttachment As Outlook.Attachment
            Dim sSaveFolder As String
            sSaveFolder = "F:\Jason - DataCopies"
            For Each oAttachment In Msg.Attachments
                oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
            Next
        End If
    End If
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub
Community
  • 1
  • 1
Jason
  • 1
  • 1
  • whats the error message? – FloLie Jun 07 '21 at 14:25
  • @FloLie there is none, the email comes through, but the attachment is not saved – Jason Jun 07 '21 at 14:26
  • Can you put a breakpoint in the bginning of the function, just to test if it is called at all? – FloLie Jun 07 '21 at 14:30
  • Did you put it in the ```ThisOutlookSession``` section? – FloLie Jun 07 '21 at 14:30
  • It is in that section @FloLie However, I just tried putting a breakpoint in and it's not being called, which is strange as it was previously – Jason Jun 07 '21 at 14:38
  • Did yu put the BP in the beginning? Put another one in the ErrorHandler and eventually restart Outlook – FloLie Jun 07 '21 at 14:41
  • @FloLie I put in both BP and restarted and it still is not being called – Jason Jun 07 '21 at 14:53
  • @FloLie I just broke it down into two separate functions, and now it is being called. However it is now giving me error code 5, invalid procedure call or argument, do you have any insights? Thanks for all your help so far! – Jason Jun 07 '21 at 15:24
  • Go back to https://stackoverflow.com/a/11267757. Insert `End Sub` and `Private Sub Items_ItemAdd(ByVal item As Object)` as shown. – niton Jun 07 '21 at 16:32
  • @niton thank you, I figured that out before but now I am running into another issue. It runs through my entire program holding the attachment and having the file path, but it doesnt save to my computer. Any ideas? – Jason Jun 07 '21 at 19:46
  • Look in F drive for your attachments, all with names starting with Jason - DataCopies. – niton Jun 07 '21 at 20:30

1 Answers1

2

It seems you are interested in the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example,MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item.

The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously.

Dim mail as Object

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Set mail =  Application.GetNamespace("MAPI").GetItemFromID(EntryIDCollection)
End Sub

Another possible way is to hook up to the ItemAdd event of the Inbox folder:

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Example Item ' call sub
    End If
End Sub

Public Sub Example(ByVal Item As Object)
    Debug.Print Item.Subject 
End Sub
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • It seems your second set of code is pretty much the same as my approach, does that mean there is an issue with mine? I tried making items_itemadd a seperate function but it still is not working. I am also a little confused at how I would implement your first recommendation/what that function does exactly. Do you think you could clear that up a bit for me? – Jason Jun 07 '21 at 15:12
  • Your code doesn't have a separate method for the event handler. – Eugene Astafiev Jun 07 '21 at 15:20
  • That fix worked! However now I'm getting error code 5, invalid procedure call or argument – Jason Jun 07 '21 at 15:23
  • Note, different object types can be passed to the event handler procedure. – Eugene Astafiev Jun 07 '21 at 15:32