Option Explicit

Const HKEY_CURRENT_USER = &H80000001

Dim strProgram
Dim strDescription
Dim blnAllowSubFolders             
Dim blnAllowNetworkLocations
Dim blnCurrentTrusted
Dim strParentKey
Dim objRegistry
Dim intHighest
Dim arrChildKeys
Dim strChildKey
Dim strValueName
Dim strNewKey
Dim strFullPath
Dim strValue
Dim objNetwork, objUser, CurrentUser
Dim strGroup
Dim CheckDrive, AlreadyConnected, intDrive 
Dim strUserName
Dim strComputerName
Dim objShell
Dim obj
Dim strFolder, strMasterFile, strUserFile
Dim strOU

strProgram = "Access"                          'Name of Microsoft program that's being set for
strFolder = "C:\EZPRO"           'Path to set as a Trusted Location
strDescription = "EZPRO Database"   'Description of the Trusted Location
blnAllowSubFolders = True                   'Trust sub folders (True or False)
blnAllowNetworkLocations = True       'Trust a network location (True or False)

strParentKey = "Software\Microsoft\Office\16.0\" & strProgram & "\Security\Trusted Locations"
intHighest = -1
blnCurrentTrusted = False

Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")

objRegistry.EnumKey HKEY_CURRENT_USER, strParentKey, arrChildKeys
'get the highest key number'
On Error Resume Next
For Each strChildKey In arrChildKeys
	If Left(strChildKey,8)="Location" Then
		If CInt(Mid(strChildKey, 9)) > intHighest Then
			intHighest = CInt(Mid(strChildKey, 9))
		End If
		
		'check to see if the folder is already trusted' 
		strValueName = "Path"
		strFullPath = strParentKey & "\" & strChildKey
		objRegistry.GetExpandedStringValue HKEY_CURRENT_USER,strFullPath,strValueName,strValue
		If strValue = strFolder Then
			blnCurrentTrusted = True
		End If
	End If
Next

If blnCurrentTrusted Then
'    MsgBox """ & strFolder & """ & " is already a Trusted Location.", vbInformation
Else
	'add new'
	If intHighest = 999 Then
		MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation
	Else
		strNewKey = strParentKey & "\Location" & CStr(intHighest + 1)
		
		objRegistry.CreateKey HKEY_CURRENT_USER, strNewKey
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Path", strFolder
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Description", strDescription
		objRegistry.SetStringValue HKEY_CURRENT_USER, strNewKey, "Date", CStr(Now())
		
		If blnAllowSubFolders Then
			objRegistry.SetDWORDValue HKEY_CURRENT_USER, strNewKey, "AllowSubFolders", 1
		End If
		
		If blnAllowNetworkLocations Then
			objRegistry.SetDWORDValue HKEY_CURRENT_USER, strParentKey, "AllowNetworkLocations", 1
		End If
		
		MsgBox """ & strFolder & """ & " added as a Trusted Location.", "Success"
	End If
End If 



Set objShell = CreateObject("WScript.Shell")

objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\VBAWarnings", 1, "REG_DWORD"
