Options for Dealing With Trusted Locations

[arnelgp]

you can use a "pre-made .exe" to put your db in Trusted Location:

Ribbons for Access 2007 / Access 2010 – Trusted Locations (accessribbon.de)

 

[nector]

From what I see , I think you need to create a form or even the login form will do , then just add a button and then place the code below

Public Function AddTrustedLocation()
On Error GoTo err_proc
'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
    
    Set reg = CreateObject("wscript.shell")
    strPath = CurrentProject.Path
    
    strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\16.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 is unused location 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
        GoTo exit_proc
    End If
    'if no unused location found then set new location for path
    If intNotUsed = 0 Then intNotUsed = i + 1
    
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:
    intNotUsed = intLocns
    Resume NextLocn
    
err_proc:
    MsgBox Err.Description
    Resume exit_proc
    
End Function

 

[theDBguy]

From what I see , I think you need to create a form or even the login form will do , then just add a button and then place the code below

Public Function AddTrustedLocation()
On Error GoTo err_proc
'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
    
    Set reg = CreateObject("wscript.shell")
    strPath = CurrentProject.Path
    
    strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\16.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 is unused location 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
        GoTo exit_proc
    End If
    'if no unused location found then set new location for path
    If intNotUsed = 0 Then intNotUsed = i + 1
    
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:
    intNotUsed = intLocns
    Resume NextLocn
    
err_proc:
    MsgBox Err.Description
    Resume exit_proc
    
End Function

As already mentioned in posts #6 and #18, this approach will only work if you run that code from an already Trusted Location.

 

[gemma-the-husky]

My understanding is that you can't manipulate the trusted locations externally. If you could, then malware could install itself.

 

[isladogs]

My understanding is that you can't manipulate the trusted locations externally. If you could, then malware could install itself.

I'm not sure what you mean here by externally but you can definitely set locations as trusted outside of Office programs as already stated in several posts in this thread. I have been doing this using installer scripts for well over a decade