Search code examples
excelvbaoutlook

Run code when email shows up in Outlook subfolder


I implemented the code offered as an answer here to run a Python script every time an email with subject "Blah" came into my Inbox.

I'm trying to implement code that would run a macro on a separate Excel spreadsheet titled main.xlsx every time an email with subject "Woo" comes into a subfolder in my inbox.

To grab all the items in this subfolder I have

Set productionItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Production Emails").Items

As a step towards the goal, I want to generate a message with Debug.Print (or message box) every time a mail called "Woo" arrives in my "Production Emails" subfolder of the Inbox.

I don't get the Debug.Print message "Arrived3", which I expect, when I send an email with subject "Woo" to myself.

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private WithEvents productionItems As Outlook.Items [!!!]
Public Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace
    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
    Set productionItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Production Emails").Items
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
    Debug.Print "Arrived3"
    If Item.Subject = "Blah" Then
        Const PyExe = "C:\...\python.exe"
        Const PyScript = "R:\...\main.py"
        
        Dim objShell As Object, cmd As String
        Set objShell = CreateObject("Wscript.Shell")
        
        cmd = PyExe & " " & PyScript
        Debug.Print cmd
        
        objShell.Run cmd
        objShell.exec cmd
        
        MsgBox objShell.exec(cmd).StdOut.ReadAll
    End If
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

Solution

  • First of all, in the code you set up the ItemAdd event handler for the Inbox folder, not a subfolder. You need to change the name of event handler if you want to receive events from a subfolder.

    You need to create a new Outlook Application instance in the code if you automate it from Excel:

    Option Explicit
    
    Private WithEvents inboxItems As Outlook.Items
    Private WithEvents productionItems As Outlook.Items
    
    Public Sub Application_Startup()
        Dim outlookApp As Outlook.Application
        Dim objectNS As Outlook.NameSpace
    
        Set outlookApp = New Outlook.Application
    
        Set objectNS = outlookApp.GetNamespace("MAPI")
        Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
        Set productionItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Production Emails").Items
    End Sub
    
    Private Sub productionItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    If TypeName(Item) = "MailItem" Then
        Debug.Print "Arrived3"
        If Item.Subject = "Blah" Then
            Const PyExe = "C:\...\python.exe"
            Const PyScript = "R:\...\main.py"
            
            Dim objShell As Object, cmd As String
            Set objShell = CreateObject("Wscript.Shell")
            
            cmd = PyExe & " " & PyScript
            Debug.Print cmd
            
            objShell.Run cmd
            objShell.exec cmd
            
            MsgBox objShell.exec(cmd).StdOut.ReadAll
        End If
    End If
    ExitNewItem:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        Resume ExitNewItem
    End Sub
    

    It seems your VBA macro was designed to be run from Outlook, not Excel. Don't forget that you need to call the Application_Startup method from Excel.