Блог

Я пытаюсь разрешить коллеге сохранять и закрывать общий рабочий лист без необходимости знать логины моего компьютера.
Файл остается открытым на случай, если им нужен файл, а не версия «только для чтения».

Важно, чтобы это срабатывало только в том случае, если книга открыта. Если возможно, это также приведет к завершению всех экземпляров макросов, которые выполняются из книги.

Я решил добавить триггер Outlook VBA, который сохраняет и закрывает его (уже присутствует в Excel) при получении почтового отправления с определенной темой.
Весь код в конце Excel работает. (Макрос сохранения и закрытия запускается в определенное время и подтверждается для работы).

В конце Outlook я добавил, как я считаю, код прослушивателя событий в ThisOutlookSession, который вызывает модуль, который должен запускать close sub в Excel.

Код в этом сеансе Outlooksession

 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 amp; " - " amp; 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
  

Сообщения об ошибках не запускаются и ничего другого не происходит.

Если вы ссылаетесь на 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 amp; " - " amp; Err.Description
'    Resume exitRoutine

End Sub