Access 2007 and Access 2010 use trusted locations as a security measure to help prevent users opening a database from an unknown source which could include malicious code. Typically, if you open a database that is not in a trusted location, Access will display a security message asking if you want to open the file.
With the full version of Access trusted locations can be added manually using the trust centre, however this option is not available if your users only have Access RunTime. This article and code provide a means to add a trusted location automatically.
The code, which should be called as part of the start up routine, e.g. from the AutoExec macro, searches the registry to see if the the current location of the database is included in the trusted locations list. If it is, the code exits. If not, the code adds the location in the first available trusted location slot available in the registry.
If the database file is opened from a non trusted location the Access security warning will be displayed and the code run when the database opens. Subsequently, as the trusted location will have been added, the Access security warning will no longer be displayed.
Code for Windows 7
Public Function AddTrustedLocation()
On Error GoTo err_proc
'WARNING: THIS CODE MODIFIES THE REGISTRY
'sets registry key for 'trusted location'
Dim intLocns As Integer
Dim i As Integer
Dim intNotUsed As Integer
Dim strLnKey As String
Dim reg As Object
Dim strPath As String
Dim strTitle as string
strTitle = "Add Trusted Location"
Set reg = CreateObject("wscript.shell")
strPath = CurrentProject.Path
'Specify the registry trusted locations path for the version of Access used
strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Format(Application.Version, "##,##0.0") & _
"\Access\Security\Trusted Locations\Location"
On Error GoTo err_proc0
'find top of range of trusted locations references in registry
For i = 999 To 0 Step -1
reg.RegRead strLnKey & i & "\Path"
GoTo chckRegPths 'Reg.RegRead successful, location exists > check for path in all locations 0 - i.
checknext:
Next
MsgBox "Unexpected Error - No Registry Locations found", vbExclamation
GoTo exit_proc
chckRegPths:
'Check if Currentdb path already a trusted location
'reg.RegRead fails before intlocns = i then the registry location is unused and
'will be used for new trusted location if path not already in registy
On Error GoTo err_proc1:
For intLocns = 1 To i
reg.RegRead strLnKey & intLocns & "\Path"
'If Path already in registry -> exit
If InStr(1, reg.RegRead(strLnKey & intLocns & "\Path"), strPath) = 1 Then GoTo exit_proc
NextLocn:
Next
If intLocns = 999 Then
MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
GoTo exit_proc
End If
'if no unused location found then set new location for path
If intNotUsed = 0 Then intNotUsed = i + 1
'Write Trusted Location regstry key to unused location in registry
On Error GoTo err_proc:
strLnKey = strLnKey & intNotUsed & "\"
reg.RegWrite strLnKey & "AllowSubfolders", 1, "REG_DWORD"
reg.RegWrite strLnKey & "Date", Now(), "REG_SZ"
reg.RegWrite strLnKey & "Description", Application.CurrentProject.Name, "REG_SZ"
reg.RegWrite strLnKey & "Path", strPath & "\", "REG_SZ"
exit_proc:
Set reg = Nothing
Exit Function
err_proc0:
Resume checknext
err_proc1:
If intNotUsed = 0 Then intNotUsed = intLocns
Resume NextLocn
err_proc:
MsgBox err.Description, , strTitle
Resume exit_proc
End Function
Code for Windows 8 64 Bit and Access 2013 64 Bit
Public Function AddTrustedLocation()
On Error GoTo err_proc
'WARNING: THIS CODE MODIFIES THE REGISTRY
'sets registry key for 'trusted location'
Dim intLocns As Integer
Dim i As Integer
Dim intNotUsed As Integer
Dim strLnKey As String
Dim reg As Object
Dim strPath As String
Dim strTitle As String
strTitle = "Add Trusted Location"
Set reg = CreateObject("wscript.shell")
strPath = CurrentProject.Path
'Specify the registry trusted locations path for the version of Access used
strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Format(Application.Version, "##,##0.0") & "\Access\Security\Trusted Locations\Location"
On Error GoTo err_proc0
'find top of range of trusted locations references in registry
For i = 999 To 0 Step -1
reg.RegRead strLnKey & i & "\Path"
GoTo chckRegPths 'Reg.RegRead successful, location exists > check for path in all locations 0 - i.
checknext:
Next
MsgBox "Unexpected Error - No Registry Locations found", vbExclamation
GoTo exit_proc
chckRegPths:
'Check if Currentdb path already a trusted location
'reg.RegRead fails before intlocns = i then the registry location is unused and
'will be used for new trusted location if path not already in registy
On Error GoTo err_proc1:
For intLocns = 1 To i
reg.RegRead strLnKey & intLocns & "\Path"
'If Path already in registry -> exit
If InStr(1, reg.RegRead(strLnKey & intLocns & "\Path"), strPath) = 1 Then GoTo exit_proc
NextLocn:
Next
If intLocns = 999 Then
MsgBox "Location count exceeded - unable to write trusted location to registry", vbInformation, strTitle
GoTo exit_proc
End If
'if no unused location found then set new location for path
If intNotUsed = 0 Then intNotUsed = i + 1
'Prompt for Location to be added
Dim MSG1 As Integer
MSG1 = MsgBox("Add to Trusted Locations", vbYesNo, "To Open You Must Trust Location")
If MSG1 = vbYes Then
'Write Trusted Location regstry key to unused location in registry
On Error GoTo err_proc:
strLnKey = strLnKey & intNotUsed & "\"
reg.RegWrite strLnKey & "AllowSubfolders", 1, "REG_DWORD"
reg.RegWrite strLnKey & "Date", Now(), "REG_SZ"
reg.RegWrite strLnKey & "Description", Application.CurrentProject.Name, "REG_SZ"
reg.RegWrite strLnKey & "Path", strPath & "\", "REG_SZ"
Else
MsgBox "Database can not be opened till trusted and will now close!", vbCritical
Set reg = Nothing
DoCmd.CloseDatabase
End If
exit_proc:
Set reg = Nothing
Exit Function
err_proc0:
Resume checknext
err_proc1:
If intNotUsed = 0 Then intNotUsed = intLocns
Resume NextLocn
err_proc:
MsgBox Err.Description, , strTitle
Resume exit_proc
End Function
Note: In some organizations, you may need to check with your IT department about adding code which modifies registry settings automatically.