Есть ли способ автоматического запуска макроса при открытии файлов Excel с похожими именами файлов?

Question

Я исследовал большое количество и попробовал это самостоятельно сегодня днем, но безуспешно.Когда пользователи загружают и открывают файлы .XLS, которые начинаются с «Current Approved», я хочу, чтобы макрос автоматически запускался из моего файла «PERSONAL.XLSB» в любом файле «Current Approved * .XLS» при его открытии (* является подстановочным знаком),Таким образом, я могу просто один раз вставить код в любой файл «PERSONAL.XLSB» любого пользователя, и макрос будет просто автоматически запущен, и пользователю не нужно будет помнить, чтобы запускать макрос с помощью сочетания клавиш или кнопки.

Из моих исследований здесь и в других местах я видел только способы:

1. Запускать макрос при открытии книги, содержащей макрос.
2. Запускать макрос при открытии любой книги.

Я пытался изменить # 2 по ссылке выше, но я НЕ выяснил, как автоматически запускать макросы таким образом для файлов с аналогичнымиnames.

'Declare the application event variable
Public WithEvents MonitorApp As Application

'Set the event variable be the Excel Application
Private Sub Workbook_Open()
    Set MonitorApp = Application
End Sub

'This Macro will run whenever an Excel Workbooks is opened
Private Sub MonitorApp_WorkbookOpen(ByVal Wb As Workbook)
    Dim Wb2 As Workbook

    For Each Wb2 In Workbooks
        If Wb2.Name Like "Current Approved*" Then
            Wb2.Activate
            MsgBox "Test"
        End If
    Next
End Sub

По сути, если я загружаю файл Excel из нашей CRM, который начинается с «Current Approved», и открываю его, я хотел бы видеть окно сообщения «Test».

Answer 1

Ваш код не похож на то, что вы описываете. Приведенный ниже код должен отображать «Тест» MsgBox при открытии рабочих книг, соответствующих правилу запуска «Текущий утвержденный»

'This Macro will run whenever an Excel Workbooks is opened
Private Sub MonitorApp_WorkbookOpen(ByVal Wb As Workbook)
    Dim cText As String
    cText = "Current Approved"

    If UCase(Left(Wb.Name, Len(cText))) = UCase(cText) Then
           ' Wb2.Activate
            MsgBox "Test"
    End If

End Sub