Have a Macro Run or Debug.Print or Message Box happen based on name and time of email that shows up-CodePudding

I was able to successfully implement the code offered as an answer here that would run a python script every time an email named "Blah" came into my Inbox.

Now, I'm trying to implement code that would run a macro on a separate excel spreadsheet titled main.xlsx every time an email named "Woo" came into a subfolder in my inbox. I have already Set productionItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Production Emails").Items to grab all the items in this subfolder. As a step to this goal, I am hoping to at least print a Debug.Print message out (or message box, whatever is fine) every time a mail called "Woo" arrives in my "Production Emails" subfolder of the Inbox. However, every time I send an email named "Woo" to myself, I don't get the Debug.Print "Arrived3" which I expect. Does anyone know why I'm not getting the Print statement?

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

CodePudding user response：

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 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

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.

CodePudding user response：

Outlook code would look like this.

Option Explicit

Private WithEvents productionItems As Items

Private Sub Application_Startup()
    Dim myInbox As Folder
    Set myInbox = Session.GetDefaultFolder(olFolderInbox)
    Set productionItems = myInbox.Folders("Production Emails").Items
End Sub


Private Sub productionItems_ItemAdd(ByVal Item As Object)

Dim Msg As MailItem

'On Error GoTo ErrorHandler     ' comment while in development

If TypeOf Item Is MailItem Then

    Debug.Print "Arrived3"
    
    Set Msg = Item
    If Msg.Subject = "Blah" Then
        With Msg
            Debug.Print " Subject.....: " & .Subject
            Debug.Print " ReceivedTime: " & .ReceivedTime
            ' code to run main.xlsx
        End With
    End If
End If

ExitNewItem:
    Exit Sub
    
ErrorHandler:
    MsgBox err.Number & " - " & err.Description
    Resume ExitNewItem
    
End Sub


Private Sub test()
    productionItems_ItemAdd ActiveInspector.CurrentItem
End Sub