Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
'--------------------------------------------------------------------------------------------
'----------------------------Do not modify above this line! ---------------------------------
'Enter Program name here: (Excel, Access, PowerPoint or Word)
strProgram = "Access"
'Get Path to current folder
strPath = [highlight #FCE94F]Wscript.ScriptFullName[/highlight]
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
strFolder = objFSO.GetParentFolderName(objFile)
'Enter Description of Trusted Location here:
strDescription = "[highlight #FCE94F][Enter value here][/highlight]"
'Enter one word description of Trusted Location here:
strName = "[highlight #FCE94F][Enter value here][/highlight]"
'If subfolders are also trusted enter "True" here:
blnAllowSubFolders = True
'----------------------------Do not modify below this line! ---------------------------------
'--------------------------------------------------------------------------------------------
strParentKey = "Software\Microsoft\Office\[highlight #FCE94F]12.0[/highlight]\" & strProgram & "\Security\Trusted Locations"
strNewKey = strParentKey & "\" & strName
Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
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
strParentKey = "Software\Microsoft\Office\[highlight #FCE94F]14.0[/highlight]\" & strProgram & "\Security\Trusted Locations"
strNewKey = strParentKey & "\" & strName
Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
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