Options for Dealing With Trusted Locations (1 Viewer)

nector

Member
Local time
Today, 19:21
Joined
Jan 21, 2020
Messages
368
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

Code:
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

I’m here to help
Staff member
Local time
Today, 09:21
Joined
Oct 29, 2018
Messages
21,474
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

Code:
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

Super Moderator
Staff member
Local time
Today, 17:21
Joined
Sep 12, 2006
Messages
15,658
My understanding is that you can't manipulate the trusted locations externally. If you could, then malware could install itself.
 

isladogs

MVP / VIP
Local time
Today, 17:21
Joined
Jan 14, 2017
Messages
18,237
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
 

Users who are viewing this thread

Top Bottom