如何关闭特定工作簿以响应接收具有特定标题的 Outlook 邮件？

Posted 2023-02-19

【中文标题】如何关闭特定工作簿以响应接收具有特定标题的 Outlook 邮件？

【英文标题】：How to close a specific workbook in response to receiving Outlook mail with a specific title?

【发布时间】：2019-09-02 23:32:58

【问题描述】：

我正在尝试允许同事保存并关闭共享工作表，而他们不必知道我的计算机登录信息。 该文件保持打开状态以防他们需要该文件，而不是“只读”版本。

重要的是，这仅在工作簿打开时触发。如果可能，它还会结束从工作簿运行的所有宏实例。

我想添加一个 Outlook VBA 触发器，当接收到具有特定主题的邮件时，它会保存并关闭它（已经存在于 Excel 中）。 Excel端的所有代码都有效。 （保存和关闭宏在特定时间触发并确认有效）。

在 Outlook 端，我向 ThisOutlookSession 添加了我认为是事件侦听器的代码，该代码调用了一个应该在 Excel 中触发关闭子的模块。

ThisOutlookSession 中的代码

Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private 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
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(Item) = "MailItem" Then
        Call Excel_Closer.Close_Excel
    End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

模块中的代码 (Excel_Closer)

保存和关闭的Excel宏是“mCloser.EmailClose”

“Nordic_Market_Monitor_2019.xlsm”是打开时要激活的工作簿。

Option Explicit
Sub Close_Excel(MyMail As MailItem)
    On Error GoTo Error_Handler
    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim strSubject As String

    strSubject = MyMail.Subject

    If strSubject = "Close Excel" Then
        On Error GoTo Error_Handler
        
        Set xlApp = GetObject(, "Excel.Application")
        Set xlBook = xlApp.Workbooks("Nordic_Market_Monitor_2019.xlsm").Activate
        
        xlApp.Visible = True

        xlBook.Application.Run "mCloser.EmailClose"

        Set xlApp = Nothing
        Set xlBook = Nothing
        
    End If
   
Error_Handler:
    Exit Sub
End Sub

不会触发任何错误消息，也不会发生其他任何事情。

【参考方案1】：

如果您参考 Excel 或工作簿，并且出现错误，则无法打开。

Sub Close_Excel(MyMail As MailItem)

    ' Remove in development phase to highlight the line with the error
    'On Error GoTo Error_Handler

    Dim xlApp As Excel.Application
    Dim xlBook As Workbook
    Dim strSubject As String

    strSubject = MyMail.Subject

    If strSubject = "Close Excel" Then

        ' "On Error Resume Next" is rarely beneficial
        '  It is here for a specific purpose

        On Error Resume Next ' bypass error if Excel is not open
        Set xlApp = GetObject(, "Excel.Application")
        On Error GoTo 0 ' Remove error bypass as soon as the purpose is served

        If Not xlApp Is Nothing Then

            'Excel is open
            On Error Resume Next ' bypass error if workbook is not open
            Set xlBook = xlApp.Workbooks("Nordic_Market_Monitor_2019.xlsm")
            On Error GoTo 0 ' Remove error bypass as soon as the purpose is served

            If Not xlBook Is Nothing Then
                ' Workbook is open
                xlApp.Visible = True
                xlBook.Application.Run "mCloser.EmailClose"

            Else
                Debug.Print "Workbook not open."

            End If

        Else
            Debug.Print "Excel not open."

        End If

    End If

exitRoutine:
    Set xlApp = Nothing
    Set xlBook = Nothing
    Exit Sub

'Error_Handler:
'    MsgBox Err.Number & " - " & Err.Description
'    Resume exitRoutine

End Sub