Search code examples
vbaemailoutlook

Execute macro on incoming mail if specific mail subject is given


I have programmed a macro that should extract the content of received mails into an Excel sheet if the mail subject contains a specific word.

All in all its working, but the macro executes as soon as I receive a mail. That leads to a pop-up window in Outlook every time I receive a mail, but I only want it to pop up if I receive a mail with the specific subject.

I have to find another solution for the line:

If TypeName(item) = "MailItem" Then Set olMail = item

The entire code:

Private Sub olItems_ItemAdd(ByVal item As Object)
    
    'Variablen dimensionieren
    Dim olMail As Outlook.MailItem
    Dim oxLApp As Object, oxLwb As Object, oxLws As Object
    
    Set oxLApp = GetObject(, "Excel.Application")
    Set oxLwb = oxLApp.Workbooks.Open _
    ("C:\Users\A2000\Desktop\Makros_NewScoping")
    Set oxLws = oxLwb.Sheets("Slide 3")
    
    'Prüfen ob Item eine Mail ist
    If TypeName(item) = "MailItem" Then
    
        Set olMail = item
        
        If InStr(olMail.Subject, "APPROVAL REQUIRED") And _
          olMail.SenderName = "Test, Name" Then
    
            With oxLws
                .Range("Q24") = olMail.VotingResponse
                .Range("E41") = olMail.Body
            End With
        End If

Solution

  • There is no need to run any extra code if the mail arrived doesn't correspond to your conditions:

    Private Sub olItems_ItemAdd(ByVal item As Object)
    
      'Variablen dimensionieren
      Dim olMail As Outlook.MailItem
      Dim oxLApp As Object, oxLwb As Object, oxLws As Object
    
      'Prüfen ob Item eine Mail ist
      If TypeName(item) = "MailItem" Then
        Set olMail = item
        
        If InStr(olMail.Subject, "APPROVAL REQUIRED") And _
    olMail.SenderName = "Test, Name" Then
    
           Set oxLApp = GetObject(, "Excel.Application")
           Set oxLwb = oxLApp.Workbooks.Open _
    ("C:\Users\A2000\Desktop\Makros_NewScoping")
           Set oxLws = oxLwb.Sheets("Slide 3")
    
           With oxLws
    
             .Range("Q24") = olMail.VotingResponse
             .Range("E41") = olMail.Body
        
           End With
         End If
    

    Note, creating a new Excel instance each time a new item is added to the folder is not really a good idea. Moreover, the ItemAdd event is fired not only for incoming emails, but also for every email moved to the folder. So, when an item is moved to the folder you will get the code triggered.

    That is why I'd suggest handling 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. Use the Entry ID represented by the EntryIDCollection string to call the NameSpace.GetItemFromID method and process the item.