How to close a specific workbook in response to receiving Outlook mail with a specific title?

Question

I'm trying to allow a colleague to save & close a shared worksheet without them having to know my computer logins.
The file is left open in case they need the file and not a "read only" version.

It is important that this only triggers if the workbook is open. If possible it would also end all instances of macros that are running from the workbook.

I figured to add an Outlook VBA trigger that saves and closes it (already present in Excel) when receiving a mailitem with a specific subject.
All the code on the Excel end works. (The save & close macro triggers at a certain time and is confirmed to work).

On the Outlook end I added what I believe is event listener code to ThisOutlookSession that calls a module that should trigger the close sub in Excel.

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

Code in module (Excel_Closer)

The Excel macro for saving and closing is "mCloser.EmailClose"

"Nordic_Market_Monitor_2019.xlsm" is the workbook to be activated if open.

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

No error messages are triggered nor does anything else happen.

niton niton · Accepted Answer · 2019-09-08T20:37:58

If you refer to Excel or the workbook and there is an error it is not open.

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

How to close a specific workbook in response to receiving Outlook mail with a specific title?

1 Answers