Private WithEvents App As Application

Private Sub Workbook_Open()
 Set App = Application
End Sub

Private Sub App_WorkbookOpen(ByVal wb As Workbook)
Set myCell = wb.Sheets(1).Range("A1:Z8").Find("*ВЕДОМОСТЬ*")
If Not myCell Is Nothing Then
MsgBox wb.Name & "     Нашел, этот файл надо обработать"
'здесь идет обработка файла макросом снятие пароля с листа, форматирование и удаление всех макросов из файла
MsgBox wb.Name & "     Обработано, все Готово"
End If
End Sub

ActiveVBProject

Sub Modules()
Dim wb2 As Workbook
Dim vbp As Object
Set wb2 = ActiveWorkbook
Set vbp = wb2.VBProject
If vbp.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbp ' ошибка полагаю здесь  надо не "ActiveVBProject "  вопрос что?
SendKeys "2000" & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, _
recursive:=True).Execute
End Sub

objSelection.Item(k).BillingInformation = "Зарегистрировано"

With objMail
        '.To = sTo 
        '.CC = "08@mail.ru" 
        '.BCC = "" 
        .Subject = nameMAIL '
        '.Body = sBody '
        '.HTMLBody = sBody 
  
        If Dir(ActiveWorkbook.FullName, 16) <> "" Then
            .Attachments.Add x 
           
        End If
     
        .Display ',ОТОБРАЗИТЬ ПИСЬМО И ЖДАТЬ ОЖИДАНИЯ ОТПРАВКИ ИЛИ ЗАКРЫИМЯ ОКНА
    End With

myItem.SaveAs ("C:\Users\*****\Desktop\555\" & rt & ".msg")

 Sub timmer()
 
 Application.OnTime Now + TimeValue("00:00:03"), "TEST"
 MsgBox ("прошло 4 секунды")
 End Sub
 
 Sub TEST()
 Application.OnTime Now + TimeValue("00:00:04"), "timmer"
MsgBox ("прошло 3 секунды")
 End Sub
 

a = Array("[!(А-Я)]", "[!(A-Z)]")
s = Cells(1, 1)
For Each el In a: s = Replace(s, el, ""): Next