根据 Outlook 文件夹中显示的电子邮件的名称和时间创建宏运行或 Debug.Print 或消息框

Question

我能够成功实施代码，每当一封名为“Blah”的电子邮件进入我的收件箱时，该代码运行一个 python 脚本。

现在，我正在尝试实现每次运行标题为 main.xlsx 的单独 excel 电子表格上的宏的代码一封名为“Woo”的电子邮件进入了我收件箱中的一个子文件夹。我已经设置 productionItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Production Emails").Items 以获取此子文件夹中的所有项目。作为实现这一目标的一个步骤，我希望每当一封名为“Woo”的邮件到达收件箱的“生产电子邮件”子文件夹时，至少打印一条 Debug.Print 消息（或消息框，随便什么） .但是，每次我向自己发送名为“Woo”的电子邮件时，我都没有收到我期望的 Debug.Print“Arrived3”。有谁知道为什么我没有收到 Print 语句？

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

Answer 1

首先，您在代码中为收件箱文件夹（而非子文件夹）设置了 ItemAdd 事件处理程序。如果您想从子文件夹接收事件，您需要更改事件处理程序的名称。

如果您从 Excel:

自动化它，您需要在代码中创建一个新的 Outlook Application 实例

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

您的 VBA 宏似乎被设计为来自 Outlook 的运行，而不是 Excel。不要忘记您需要从 Excel.

调用 Application_Startup 方法

Answer 2

Outlook 代码如下所示。

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

根据 Outlook 文件夹中显示的电子邮件的名称和时间创建宏运行或 Debug.Print 或消息框

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

excel

vba

outlook

office-automation

com-automation

根据 Outlook 文件夹中显示的电子邮件的名称和时间创建宏 运行 或 Debug.Print 或消息框

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

excel

vba

outlook

office-automation

com-automation

根据 Outlook 文件夹中显示的电子邮件的名称和时间创建宏运行或 Debug.Print 或消息框