Adding Windows 7 registry values for Trust Center from Access 2013 VBA

[DBAMJA]

I have an application that is distributed to almost 30 sites with some sites having multiple computers. I have a secondary database on a common server that holds objects that need updating at each of the sites. When the site opens the database, it goes out and checks to see if there is a difference in the version number that is on the server compared to the local version. If the versions are different, the database copies the objects that need updating and replaces them in the local database. The problem that I am having is the Trust Center settings are causing a security warning to appear for each object that needs to be copied and the user needs to click on an open button for each object. I need to write to the registry to add the folder location as a trusted location so these warnings don't appear each time. Any idea on how I can accomplish this?

I hope this makes sense and thank you in advance for any and all advice.

[flush]

Michael

It is said that God will give you no more than you can handle. I just wish God didn't think I was just a bad ass.

 

[dhookom]

I use a vbscript file that creates a folder in the user's system folder, sets it to trusted, copies the front-end to the folder, and then runs the application. I think you should be able to pull what you need from this code. It actuall should work for most versions of Access through 2013.

[COLOR=#4E9A06]'===================
' File: TrustCopyRun.vbs
'===================[/color]
   Const SystemFolder= 1
   Dim fso  'to be used for file related code
   Dim SysFolder
   Dim SysFolderPath
   dim strUserLogin 
   Dim RegEdPath
   Dim strAppFolder
   Dim strAppName
   Dim strAppFile
   Dim strAppNetworkFile 
[COLOR=#4E9A06]
'==============================================================
'  edit the values in the next three lines to match your application and network location[/color]
   strAppName = "YourApp"
   strAppFile = "YourApp.accdb"
   strAppNetworkFile = "\\ServerName\AppFolder\YourApp.accdb"
[COLOR=#4E9A06]'==============================================================[/color]
   Set fso = wscript.CreateObject("Scripting.FileSystemObject")
   Set SysFolder =fso.GetSpecialFolder(SystemFolder)
   SysFolderPath= SysFolder.Path

[COLOR=#4E9A06]   'initialize the script shell object[/color]
   Set WshShell = WScript.CreateObject("WScript.Shell")
   strUserLogin = WshShell.ExpandEnvironmentStrings("%USERNAME%") 
   strAppFolder = "C:\users\" & strUserLogin & "\" & strAppName
   if not fso.FolderExists(strAppFolder) Then
      fso.CreateFolder strAppFolder
   End If

[COLOR=#4E9A06]   'SNOW4 Office 12[/color]
   RegEdPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\"
   WshShell.RegWrite  RegEdPath  ,strAppName
[COLOR=#4E9A06]   'Write the values into the registry[/color]
   WshShell.RegWrite  RegEdPath & strAppName & "\Path" , "C:\Users\" & strUserLogin & "\" & strAppName & "\"
   WshShell.RegWrite  RegEdPath & strAppName & "\AllowSubfolders" , 1, "REG_DWORD"

[COLOR=#4E9A06]   'SNOW5 Office 14[/color]
   RegEdPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\"
   WshShell.RegWrite  RegEdPath  ,strAppName
[COLOR=#4E9A06]   'Write the values into the registry[/color]
   WshShell.RegWrite  RegEdPath & strAppName & "\Path" , "C:\Users\" & strUserLogin & "\" & strAppName & "\"
   WshShell.RegWrite  RegEdPath & strAppName & "\AllowSubfolders" , 1, "REG_DWORD"
   
[COLOR=#4E9A06]    'SNOW5 Office 15[/color]
   RegEdPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Access\Security\Trusted Locations\"
   WshShell.RegWrite  RegEdPath  ,strAppName
[COLOR=#4E9A06]   'Write the values into the registry[/color]
   WshShell.RegWrite  RegEdPath & strAppName & "\Path" , "C:\Users\" & strUserLogin & "\" & strAppName & "\"
   WshShell.RegWrite  RegEdPath & strAppName & "\AllowSubfolders" , 1, "REG_DWORD"

[COLOR=#4E9A06]   'copy the application file from the network location to the local folder[/color] 
   fso.CopyFile strAppNetworkFile ,strAppFolder & "\", 1
[COLOR=#4E9A06]   'run the application[/color]
   wshshell.Run strAppFolder & "\" & strAppFile

wscript.Quit

Duane
Hook'D on Access
MS Access MVP