Sub pop()
' Меняем доверие  к проектам VBA и уровень безопасности
Dim i As Integer, objExcel As Object, objShell As Object, vatDir As String, vatReturn As Currency, _
Papka As String, AppExcel As Excel.Application

On Error Resume Next

'   Версия Excel: 9.0 - 2000, 10.0 - 2002, 11.0 - 2003 и т.д.
Set objExcel = CreateObject("Excel.Application")
Set objShell = CreateObject("WScript.Shell")

For i =  0  To  50 
On Error GoTo  150 
vatDir = objShell.RegRead( _
"HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Trusted Locations\Location" & i & "\Path")
'On Error Resume Next
If vatDir = ThisWorkbook.Path Then Exit For
If i <  0  Then
 150  objShell.RegWrite _
    "HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Trusted Locations\Location" & i & "\Description", "Назовите сами", "REG_SZ"  'прописывает доверительную директорию для Excel 2007 и выше.
    objShell.RegWrite _
    "HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Trusted Locations\Location" & i & "\AllowSubfolders",  1 , "REG_DWORD"
    objShell.RegWrite _
    "HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Trusted Locations\Location" & i & "\Path", ThisWorkbook.Path, "REG_SZ"
    'разрешение доступа к сетевым папкам
    objShell.RegWrite _
"HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Trusted Locations\AllowNetworkLocations",  1 , "REG_DWORD"
Exit For
End If
Next


On Error GoTo  200 
vatReturn = objShell.RegRead( _
"HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\AccessVBOM")

If vatReturn =  0  Then
    '   За доверительный доступ к проектам VBA отвечает параметр "AccessVBOM"
 200  objShell.RegWrite _
    "HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\AccessVBOM",  1 , "REG_DWORD"
    '   За уровень безопасности отвечает параметр "Level"
    objShell.RegWrite _
    "HKEY_CURRENT_USER\Software\Microsoft\Office\" & objExcel.Version & "\Excel\Security\Level",  1 , "REG_DWORD"
    
End If

    Set AppExcel = New Excel.Application '
    AppExcel.Visible = True
    AppExcel.Workbooks.Open(Filename:="Ваш файл").RunAutoMacros Which:=xlAutoOpen
    Excel.Application.Quit

End Sub