X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Trusted Location No Longer Working With Unc-path, Access 2010    
post Oct 26 2017, 09:04 AM

Posts: 90
Joined: 28-November 06


We use A2010 to develop and maintain our own database. For some time (2-3 month??) now we get the 'Security Warning' 'Some active content has been disabled. Click for more details. <Enable Content> message every time we start the application form a second machine.

For that time we just clicked the message away. Now we want to solve this.

The machines are connected by a LAN, but there is no server. The developer machine just shares a drive and the second machine uses an UNC-path ('\\servername\share\path') to access the database. On the developer machine the database can be opened as always and starta. On the second machine however we always get the above prompt!

The path of the application is properly stored under
- Computer\HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations\Location1
but the security warning pops up every time the database is opened.

The developer machine runs under Win7, the second machine has been upgraded to Win10 after a problem with Win7. I think this might be the moment the problems started, but we are not sure. Under Win7 our Trust Center has several submenus. This seems to be gone under Win10 - seems we only have, what is listed the Win7 Trust Center under 'Message bar'. Whatever we do: next time we start the application the nag-prompt pops up!

AddTrustedLocation as decribed in UtterAccess AddTrustedLocation does not work (well, the path to the location exists...)

Serching the Web I found this Can't add network directories as Trusted Locations anymore?! Does this possibly imply it is not possible at all under Win10 with A2010?

Any ideas how we could solve this?
Go to the top of the page
post Oct 27 2017, 11:09 AM

Posts: 90
Joined: 28-November 06

I found the solution for this problem. You needed to add:
[HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\Trusted Locations]

For now I did this manually, but I think it should be added here: UtterAccess AddTrustedLocation. However: This code is written so unreadable, that I think more than just setting the value for "AllowSubFolders" should be used to make this code easy readable and maintainable... - Sorry, I have not the time to do this now!
Go to the top of the page
post Oct 28 2017, 08:07 AM

UtterAccess VIP
Posts: 11,691
Joined: 6-December 03
From: Telegraph Hill

I had a look at the function in the wiki, and agree that it is difficult to understand what the code is doing.

I've had a stab at re-writing it in a more logical fashion, and including your requirement to AllowNetworkLocations if required.

Will you test to see if it works as expected. I don't know what will happen if the user can't write to the registry!

If it works for you (and anyone else coming across this thread) and you think it's clearer than the other version I will update the wiki with it.

Option Compare Database
Option Explicit

Function AddTrustedLocation(strLocationPath As String, _
                            Optional blIncludeSubfolders As Boolean, _
                            Optional strDescription As String) As Boolean
On Error GoTo Err_AddTrustedLocation

  Const DWORD             As String = "REG_DWORD", _
        SZ                As String = "REG_SZ", _
        ALLOW_SUBFOLDERS  As String = "AllowSubfolders", _
        NETWORK_LOCATION  As String = "AllowNetworkLocations", _
        LOCATION_KEY      As String = "Location", _
        DATE_KEY          As String = "Date", _
        PATH_KEY          As String = "Path", _
        DESCRIPTION_KEY   As String = "Description", _
        MAX_LOCATIONS     As Integer = 999, _
        BS                As String = "\"

  Const LOC_KEY_1         As String = "HKEY_CURRENT_USER\Software\Microsoft\Office\", _
        LOC_KEY_2         As String = "\Access\Security\Trusted Locations"

    Dim blRet             As Boolean, _
        strVersion        As String, _
        strLocKey         As String, _
        strKeyVal         As String, _
        i                 As Integer

  strVersion = Application.Version
  If Right(strLocationPath, 1) <> BS Then
    strLocationPath = strLocationPath & BS
  End If
  With CreateObject("wscript.shell")
    On Error Resume Next
    For i = 1 To MAX_LOCATIONS
      strLocKey = LOC_KEY_1 & strVersion & LOC_KEY_2 & BS & LOCATION_KEY & i & BS
      strKeyVal = .RegRead(strLocKey & PATH_KEY)
      If Err = 0 Then
        If InStr(strLocationPath, strKeyVal) > 0 Then
          If strKeyVal = strLocationPath Then
'           Trusted location already exists
            Debug.Print "Trusted location '" & strLocationPath & "' already exists."
            blRet = True
            Exit For
'           A folder higher up the path is trusted, check whether it includes subfolders
            strKeyVal = .RegRead(strLocKey & ALLOW_SUBFOLDERS)
            If Err = 0 Then
              If Val(strKeyVal) = 1 Then
                Debug.Print "'" & strLocationPath & "' is trusted as a subfolder of '" & .RegRead(strLocKey & PATH_KEY) & "'"
                blRet = True
                Exit For
              End If
            End If
          End If
        End If
        On Error GoTo Err_AddTrustedLocation
'       Location not found, we can use it to create new location
        .RegWrite strLocKey & PATH_KEY, strLocationPath, SZ
        .RegWrite strLocKey & DATE_KEY, Now, SZ
        .RegWrite strLocKey & DESCRIPTION_KEY, strDescription, SZ
        If blIncludeSubfolders Then
          .RegWrite strLocKey & ALLOW_SUBFOLDERS, DWORD
        End If
        Debug.Print "'" & strLocationPath & "' is now a Trusted Location.", "[" & strLocKey & "]"
'       If the location is a network share then this key needs to be added to Trusted Locations
        Select Case True
        Case Left(strLocationPath, 2) = BS & BS, IsMappedDrive(Left(strLocationPath, 2))
          strLocKey = LOC_KEY_1 & strVersion & LOC_KEY_2 & BS & NETWORK_LOCATION
          .RegWrite strLocKey, 1, DWORD
          Debug.Print "Trusted locations can include network shares.", "[" & strLocKey & "]"
        End Select
        blRet = True
        Exit For
      End If
    Next i
    If Not blRet Then
      MsgBox "Unable to add any more Trusted Locations - " & MAX_LOCATIONS & " have already been created.", _
             vbOKOnly + vbInformation, _
             "Location count exceeded"
    End If
  End With

  AddTrustedLocation = blRet
  Exit Function

  Select Case Err.Number
  Case Else
    MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
           "Description: " & Err.Description & vbNewLine & vbNewLine & _
           "Function: AddTrustedLocation" & vbNewLine & _
           IIf(Erl, "Line No: " & Erl & vbNewLine, "") & _
           "Module: basTrustedLocation", , "Error: " & Err.Number
  End Select
  Resume Return_Result

End Function

Function IsMappedDrive(strDrive As String) As Boolean
' adapted from:
' http://www.la-solutions.co.UK/content/V8/MVBA/MVBA-Mapped-Drives-UNC.htm#GetMappedPathFromDrive
  Dim i As Integer
  With CreateObject("WScript.Network")
    With .EnumNetworkDrives
      If .Count Then
        For i = 0 To .Count - 1 Step 2
          If .Item(i) = strDrive Then
            IsMappedDrive = True
            Exit For
          End If
        Next i
      End If
    End With
  End With
End Function

[edited IsMappedDrive() function to only loop if any mapped drives are found]

All corrections/suggestions welcome.


Go to the top of the page
post Oct 28 2017, 09:46 AM

Posts: 84
Joined: 12-March 06
From: Redmond, WA

Check out my download page http://www.datarim.com/Downloads.html
Under utilities, DI Shortcuts will copy your front end from a network location to the local workstation, creates shortcuts and start menu folders, plus sets Access trust folders and more.
Free license if you mention UtterAccess or PNWADG.
Go to the top of the page

Custom Search

RSSSearch   Top   Lo-Fi    18th November 2019 - 05:29 PM