I have a VBA script in ThisOutlookSession I want to call a Python script when an email arrives in my inbox.
My inbox has rules to move emails from specific senders into sub folders. When an email comes in that has a rule applied, my Python script does not get called.
I have looked at some solutions but they all appear to be hard coded in that the sub folders are directly referenced. I want to use this setup in my organsiation where I will have many users and inboxes with differing sub folder structures, so I am looking for a less hard coded solution.
I also understand that it may not be best to use rules and instead implement their functionality directly into the VBA script. As I wish to expand this to many users whilst retaining their ability to create new rules, I cannot use this method as it will require too much work to maintain when users want new rules.
Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items
Debug.Print "Application_Startup triggered " & Now()
End Sub
Private Sub olItems_ItemAdd(ByVal item As Object)
Dim my_olMail As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Dim obj As Object
Dim PythonExe As String
Dim Script As String
Set obj = VBA.CreateObject("Wscript.Shell")
PythonExe = """C:\python"""
Script = Environ("userprofile") & "\Python-Scripts\Outlook-Sound-Lock-Screen\play-sound.py"
Debug.Print "Script Path: " & Script
obj.Run "cmd /c cd /d" & PythonExe & "&& " & "python" & " " & Script, 0, True
Set my_olMail = item
Debug.Print "Sender: "; my_olMail.SenderEmailAddress & " | Subject: " & my_olMail.Subject
Set my_olMail = Nothing
End If
End Sub
Following Eugene Astafiev's advice to use the NewMailEx() event I have been able to trigger my python script upon receiving a new email in the inbox and it's sub folders. I also fixed the issue related to the initialisation of the olApp raised by Eugene Astafiev.
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Application
Set olNS = olApp.GetNamespace("MAPI")
Debug.Print "Application_Startup triggered " & Now()
End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim obj As Object
Dim PythonExe As String
Dim Script As String
Set obj = VBA.CreateObject("Wscript.Shell")
PythonExe = """C:\python"""
Script = Environ("userprofile") & "\Python-Scripts\Outlook-Sound-Lock-Screen\play-sound.py"
obj.Run "cmd /c cd /d" & PythonExe & "&& " & "python" & " " & Script, 0, True
End Sub