VBA - How to programmatically enable access to the VBA object model using macros

    Under certain circumstances a programmer may need to access the VB object model for an Office application and interact with its VBIDE interface (clean-up missing references, back-up macro code ... etc).
    As described in https://support.microsoft.com/kb/282830, the code may fail with the following errors:

 

https://support.microsoft.com/kb/282830Programmatic access to Office VBA project is denied-------------------------------------------------------------------From Visual Basic or VBA:    Run-time error '6068': Programmatic Access to Visual Basic Project is not trusted From Microsoft Visual C++, Microsoft Foundation Classes (MFC), or ActiveX Template Library (ATL):    HRESULT = 0x800A17B4 (-2146822220) "Programmatic Access to Visual Basic Project is not trusted"

... if 'Trust access to the VBA project object model'  setting is not turned ON.

    If we run a ProcMon while changing this option for any Office program, we will notice that the application will write an entry into this registry key: "HKEY_CURRENT_USER\Software\Microsoft\Office\<App.Version>\<App>\Security\AccessVBOM". Now that we know where it is stored, we can try to programmatically set its value using a VBA macro, but the setting will not be taken into account until the application restarts. And if you try to restart the application, you will notice that your modification will be lost!   

    It seems that the Office application will remember what was the value for this keywhen it first started. If while the application is running you attempt to modify the 'AccessVBOM' key by any method (macro, script, manually editing the key ...etc), except for going in 'Options' > 'Trust Center' > 'Trust Center Setting' > 'Macro Settings', your change will be discarded on exit. Since you need to exit the application and load it again for the setting to become effective, you cannot programmatically enable / disable access to VB object model.

    But if we set our key's value when the target Office application is not running, then the modified setting will be taken into account. 

   

    In case you have to run your macro in an environment where you don't know for sure if an user has enabled his 'Trust access to the VBA project object model' setting, you can execute the macro samples from below. What the code performs first is a check to make sure that the registry key exists by calling the 'TestIfKeyExists(strRegPath)' function. Next it performs these actions:
-  if the function returns FALSE, it will write a .VBS script file in the working folder;
    > then a message box is going to be displayed announcing that the application will be restarted for some setting to be effective;
    > control is handed over to the 'WriteVBS' method which will write a set of VBScript commands into a text file;
> when it finishes, it fires up the VB script from the VB macro via the SHELL object;
> finally, the Word application shuts down;   

    > but the VB script continues to run, and it will wait for the user to click a message box (I used a message box to avoid complicating my code too much .. otherwise I would have needed some timers in order for the script to be delayed enough, because Word has to have a chance to close down properly);
    > the script takes care of writing this registry entry " [HKEY_LOCAL_MACHINE/Software/Microsoft/Office/<APP VER>/<App>/Security/AccessVBOM"=dword:00000001" (<APP VER> can be '12.0' for Office 2007 and '14.0' for Office 2010 and <App> can be 'Word' or 'Excel' ..etc);

 

- if the function evaluates to TRUE,  it means that we have access to the VB object model and we cycle all references to prove that everything works (of course ... in the real life scenario, this is the place where you should execute your code);

 

The following code sample targets the Word 2007 application.

 

The script I have offered is just a proof of concept and should not be put into production without a thorough testing!Microsoft is not responsible if your users will lose data because of this code. It’s your responsibility to test it before deployment in your organization.

 

 ' ==============================================================' * Please note that Microsoft provides programming examples' * for illustration only, without warranty either expressed or' * implied, including, but not limited to, the implied warranties of ' * merchantability and/or fitness for a particular purpose. Any of' * the code provided use by you in this blog is at your own risk.'===============================================================Sub CheckIfVBAAccessIsOn()'[HKEY_LOCAL_MACHINE/Software/Microsoft/Office/10.0/Excel/Security]'"AccessVBOM"=dword:00000001Dim strRegPath As StringstrRegPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Word\Security\AccessVBOM"If TestIfKeyExists(strRegPath) = False Then'   Dim WSHShell As Object'   Set WSHShell = CreateObject("WScript.Shell")'   WSHShell.RegWrite strRegPath, 3, "REG_DWORD"   MsgBox "A change has been introduced into your registry configuration. The Word application will now restart."   WriteVBS   Application.QuitEnd If Dim VBAEditor As Object     'VBIDE.VBEDim VBProj    As Object     'VBIDE.VBProjectDim tmpVBComp As Object     'VBIDE.VBComponentDim VBComp    As Object     'VBIDE.VBComponentSet VBAEditor = Application.VBESet VBProj = Application.ActiveDocument.VBProjectDim counter As IntegerFor counter = 1 To VBProj.References.CountDebug.Print VBProj.References(counter).FullPath'Debug.Print VBProj.References(counter).NameDebug.Print VBProj.References(counter).DescriptionDebug.Print "---------------------------------------------------"NextEnd Sub Function TestIfKeyExists(ByVal path As String) Dim WshShell As Object Set WshShell = CreateObject("WScript.Shell") On Error Resume Next WshShell.RegRead path    If Err.Number <> 0 Then       Err.Clear       TestIfKeyExists = False    Else       TestIfKeyExists = True    End If On Error GoTo 0End Function Sub WriteVBS()Dim objFile     As ObjectDim objFSO      As ObjectDim codePath    As StringcodePath = ActiveDocument.path & "\reg_setting.vbs"Set objFSO  = CreateObject("Scripting.FileSystemObject")Set objFile = objFSO.OpenTextFile(codePath, 2, True)objFile.WriteLine (" On Error Resume Next")objFile.WriteLine ("")objFile.WriteLine ("Dim WshShell")objFile.WriteLine ("Set WshShell = CreateObject(""WScript.Shell"")")objFile.WriteLine ("")objFile.WriteLine ("MsgBox ""Click OK to complete the setup process.""")objFile.WriteLine ("")objFile.WriteLine ("Dim strRegPath")objFile.WriteLine ("Dim Application_Version")objFile.WriteLine ("Application_Version = """ & Application.Version & """")objFile.WriteLine ("strRegPath = ""HKEY_CURRENT_USER\Software\Microsoft\Office\"" & Application_Version & ""\Word\Security\AccessVBOM""")objFile.WriteLine ("WScript.echo strRegPath")objFile.WriteLine ("WshShell.RegWrite strRegPath, 1, ""REG_DWORD""")objFile.WriteLine ("")objFile.WriteLine ("If Err.Code <> o Then")objFile.WriteLine ("   MsgBox ""Error"" & Chr(13) & Chr(10) & Err.Source & Chr(13) & Chr(10) & Err.Message")objFile.WriteLine ("End If")objFile.WriteLine ("")objFile.WriteLine ("WScript.Quit")objFile.CloseSet objFile = NothingSet objFSO  = Nothing'run the VBscript code' > The macro will fail to execute the VB script if you use a'   [codepath] which contains blanks!'' > To fix this issue, we add a pair of double quotes (" ") around'   [codepath];Shell "cscript " & chr(34) & codePath & chr(34), vbNormalFocusEnd Sub

 

Here is how the VB script will look like once it is written to a TXT file:

VB Script listing                                                    -------------------------------------------------------------------On Error Resume NextDim WshShellSet WshShell = CreateObject("WScript.Shell")MsgBox "Click OK to complete the setup process."Dim strRegPathDim Application_VersionApplication_Version = "12.0"strRegPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application_Version & "\Word\Security\AccessVBOM"WScript.echo strRegPathWshShell.RegWrite strRegPath, 1, "REG_DWORD"If Err.Code <> 0 Then   MsgBox "Error" & Chr(13) & Chr(10) & Err.Source & Chr(13) & Chr(10) & Err.MessageEnd IfWScript.Quit

 

Thank you for reading my article! Bye :-)