HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations
HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\NameOfYourLocation
Root = CU
Key = Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\MyProject
Name = Path
Value = D:\Custom\Folder
Root = CU
Key = Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\MyProject
Name = AllowSubfolders
Value = #00000001
Root = CU
Key = Software\Microsoft\Office\14.0\Access\Security\Trusted Locations
Name = AllowNetworkLocations
Value = #00000001
Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Dim strProgram
Dim strFolder
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
strProgram = "Access" 'Name of Microsoft program that's being set for
strFolder = "D:\Custom\Folder" 'Path to set as a Trusted Location
strDescription = "my custom folder" 'Description of the Trusted Location
blnAllowSubFolders = True 'Trust sub folders (True or False)
blnAllowNetworkLocations = False 'Trust a network location (True or False)
strParentKey = "Software\Microsoft\Office\14.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
Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations]
"AllowNetworkLocations"=dword:00000001
[HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\MyLocation]
"Date"="12.11.2012 14:58"
"Description"="MyProject"
"Path"="C:\\MyFolder\\SecondFolder\\"
"AllowSubfolders"=dword:00000001
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (3)
Commented:
strVersion = Application.VERSION
strParentKey = "Software\Microsoft\Office
Thanks again.
Author
Commented:Commented:
I have been on vacation and am now back to work. I had hoped to take care of this before leaving, but everything I do seems to take longer than it should. Sound familiar?
I prefer to keep the question open until I can determine which solution works best for me. Thanks everyone who has helped, your patience in allow me to best use this service is appreciated!
Calabria