none
how could i create a trusted location on the customer system? RRS feed

  • Question

  • hi.this is a problem that i need help with because the button doesnt work in accde sometimes.thanks.

    microsoft

    Monday, January 16, 2017 1:31 PM

Answers

  • Here's some code I had put together a while ago I just came across again.

    '*******************************************************************************
    ' Purpose   : Create a truted location
    ' Author    : Daniel Pineault, CARDA Consultants Inc.
    ' Website   : http://www.cardaconsultants.com
    ' Copyright : The following may be altered and reused as you wish so long as the
    '             copyright notice is left unchanged (including Author, Website and
    '             Copyright).  It may not be sold/resold or reposted on other sites (links
    '             back to this site are allowed).
    '
    'Usage      : CreateTL "winword.exe",application.CurrentProject.Path & "\Modeles\","MyProjectName",True,True
    'Revision:
    ' 1             2010-06-23  Initial Release
    ' 2             2015-07-06  Modified to be used in VBA within FP
    '*******************************************************************************
    Function CreateTL(ByVal sAppExe As String, ByVal sPath As String, ByVal sDescription As String, _
                      Optional bAllowSubFolders As Boolean = -1, _
                      Optional bAllowNetworkLocations As Boolean = 0)
        On Error GoTo Error_Handler
        Const HKEY_CURRENT_USER = &H80000001
        Dim oRegistry
        '    Dim sPath                                         'Path to set as a Trusted Location
        '    Dim sDescription                                  'Description of the Trusted Location
        '    Dim bAllowSubFolders                              'Enable subFolders as Trusted Locations
        '    Dim bAllowNetworkLocations As Boolean             'Enable Network Locations as Trusted Locations
        Dim sApp                  As String
        Dim sAppVer               As String
        Dim bAlreadyExists        As Boolean
        Dim sParentKey            As String
        Dim iLocCounter           As Integer
        Dim arrChildKeys
        Dim sChildKey
        Dim sValue                As String
        Dim sNewKey               As String
    
        'Determine the location/path of the user's MyDocuments folder
        '*******************************************************************************
        Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
        '    sPath = "TheFullPathOfYourTrustedLocation"        'ie: c:\databases\
        '    sDescription = "YourTrustedLocationDescriptionGoesHere"
        '    bAllowSubFolders = True
        bAlreadyExists = 0
    
        'Determine the current verion of the App
        sAppVer = GetAppVersion(sAppExe)                  '   Returns: 12.0.6720.5000
        sAppVer = ExtractNthTerm(sAppVer, ".", 1) & "." & ExtractNthTerm(sAppVer, ".", 2)
        'Build the corresponding RegKeyPath
        Select Case sAppExe
            Case "msaccess.exe"
                sApp = "Access"
            Case "winword.exe"
                sApp = "Word"
            Case "excel.exe"
                sApp = "Excel"
        End Select
        sParentKey = "Software\Microsoft\Office\" & sAppVer & "\" & sApp & "\Security\Trusted Locations"
        '    sParentKey = "Software\Microsoft\Office\12.0\Access\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\Excel\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\PowerPoint\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\Word\Security\Trusted Locations"
    
        iLocCounter = 0
        oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
        For Each sChildKey In arrChildKeys
            oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
            If sValue = sDescription Then bAlreadyExists = True
    
            If CInt(Mid(sChildKey, 9)) > iLocCounter Then
                iLocCounter = CInt(Mid(sChildKey, 9))
            End If
        Next
    
        'Uncomment the following 4 linesif your wish to enable network locations as Trusted
        '   Locations
        '   bAllowNetworkLocations = True
        If bAllowNetworkLocations = -1 Then
            oRegistry.SetDWORDValue HKEY_CURRENT_USER, sParentKey, "AllowNetworkLocations", 1
        End If
    
        If bAlreadyExists = 0 Then
            sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)
    
            oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
            oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
            oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription
    
            If bAllowSubFolders = -1 Then
                oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1
            End If
        End If
    
    Error_Handler_Exit:
        On Error Resume Next
        Set oRegistry = Nothing
        Exit Function
    
    Error_Handler:
        LogError Err.Number, Err.Description, sModName & "/CreateTL", , True
        Resume Error_Handler_Exit
    End Function


    'GetAppVersion("winword.exe")
    '   Returns: 12.0.6720.5000
    Function GetAppVersion(sAppExe As String) As String
        On Error GoTo Error_Handler
        Const HKEY_LOCAL_MACHINE = &H80000002
        Dim oRegistry
        Dim oFSO
        Dim sKey
        '    Dim sAppExe
        Dim sValue
    '    Dim sAppVersion
    
        Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/default:StdRegProv")
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        sKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"
        'sAppExe = "excel.exe"
        'sAppExe = "GROOVE.exe"
        'sAppExe = "infopath.exe"
        '    sAppExe = "MSACCESS.EXE"
        'sAppExe = "MSPUB.EXE"
        'sAppExe = "OneNote.exe"
        'sAppExe = "OUTLOOK.EXE"
        'sAppExe = "winword.exe"
        'sAppExe = "firefox.exe" 'Even works with a number of other programs!
        oRegistry.GetStringValue HKEY_LOCAL_MACHINE, sKey & "\" & sAppExe, "", sValue
        GetAppVersion = oFSO.GetFileVersion(sValue)
    
    Error_Handler_Exit:
        On Error Resume Next
        Set oFSO = Nothing
        Set oRegistry = Nothing
        Exit Function
    
    Error_Handler:
        LogError Err.Number, Err.Description, sModName & "/GetAppVersion", , True
        Resume Error_Handler_Exit
    End Function

    One precision, in my code, and a lot of other code you'll see us creating TL with sequential names

    • Location0
    • Location1
    • Location2
    • and so on

    we are merely following what MS uses, but in reality, you can name it as you like and make it more meaningful!


    Daniel Pineault, 2010-2016 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net






    Sunday, January 22, 2017 4:12 PM

All replies

  • Hi,

    Trusted Locations are created and stored in the Registry. Check out this website for the registry keys and you can also download a program to add a trusted location before running your runtime application.

    Hope it helps...

    Monday, January 16, 2017 2:58 PM
  • thanks.i will test if it solve my problem.i wish you write  simple code here.

    microsoft

    Tuesday, January 17, 2017 7:22 AM
  • Hi,

    Good luck!

    Tuesday, January 17, 2017 7:39 PM
  • i found something strange.i have two acde file in one directory that is not trusted on a usb flash.that one of them the button works while the other diesnt work.any idea?an other thing is that i want to register the trust location just one time for my customers not every time they run the program .how could i do it?  thanks.

    microsoft

    Wednesday, January 18, 2017 7:05 AM
  • Hi,

    Access trust settings has two types: trusted locations and trusted documents. The program I linked to earlier will add the current folder to the trusted locations. Any Access file you store in the trusted folder will automatically be trusted by Access. When you get the Enable Code warning and click on it, then the file is added to the list of trusted documents. Any time you move a file to a non trusted folder or change its name, then the file will not be trusted again.

    So, did you download the program from the above link? If so, have you run it from the folder where you want your trusted applications to be stored?

    Hope it helps...

    Wednesday, January 18, 2017 4:47 PM
  • you right.but we dont know where the customer is going to store the program until first running the program.and after that we want to define that directory trusted one time.doing this is a problem.

    microsoft

    Thursday, January 19, 2017 6:56 AM
  • you right.but we dont know where the customer is going to store the program until first running the program.and after that we want to define that directory trusted one time.doing this is a problem.

    microsoft

    What I think you need is an "installer" for your program. An installer will run outside of Access. When the installer is launched, the user can select where they want to store the application or you could select it for them as a default. The installer can then set the selected location as a trusted location.

    Hope it helps...

    • Marked as answer by majzad Friday, January 20, 2017 6:37 AM
    • Unmarked as answer by majzad Friday, January 20, 2017 6:38 AM
    Thursday, January 19, 2017 4:29 PM
  • i test inno setup and auto run pro for packing.but no one had these features.what is your suggestion?

    microsoft

    Friday, January 20, 2017 6:37 AM
  • i want to make a trusted location on front end by an installer or vba.i need help if possible.thanks.

    microsoft

    Sunday, January 22, 2017 7:49 AM
  • Take a look at:

    http://www.accessribbon.de/en/?Trust_Center:Trusted_Locations

    http://www.devhut.net/2010/06/23/vbscript-createset-trusted-location-using-vbscript/

    or Google, there are tons of example to inspire yourself from.


    Daniel Pineault, 2010-2016 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Sunday, January 22, 2017 4:01 PM
  • Here's some code I had put together a while ago I just came across again.

    '*******************************************************************************
    ' Purpose   : Create a truted location
    ' Author    : Daniel Pineault, CARDA Consultants Inc.
    ' Website   : http://www.cardaconsultants.com
    ' Copyright : The following may be altered and reused as you wish so long as the
    '             copyright notice is left unchanged (including Author, Website and
    '             Copyright).  It may not be sold/resold or reposted on other sites (links
    '             back to this site are allowed).
    '
    'Usage      : CreateTL "winword.exe",application.CurrentProject.Path & "\Modeles\","MyProjectName",True,True
    'Revision:
    ' 1             2010-06-23  Initial Release
    ' 2             2015-07-06  Modified to be used in VBA within FP
    '*******************************************************************************
    Function CreateTL(ByVal sAppExe As String, ByVal sPath As String, ByVal sDescription As String, _
                      Optional bAllowSubFolders As Boolean = -1, _
                      Optional bAllowNetworkLocations As Boolean = 0)
        On Error GoTo Error_Handler
        Const HKEY_CURRENT_USER = &H80000001
        Dim oRegistry
        '    Dim sPath                                         'Path to set as a Trusted Location
        '    Dim sDescription                                  'Description of the Trusted Location
        '    Dim bAllowSubFolders                              'Enable subFolders as Trusted Locations
        '    Dim bAllowNetworkLocations As Boolean             'Enable Network Locations as Trusted Locations
        Dim sApp                  As String
        Dim sAppVer               As String
        Dim bAlreadyExists        As Boolean
        Dim sParentKey            As String
        Dim iLocCounter           As Integer
        Dim arrChildKeys
        Dim sChildKey
        Dim sValue                As String
        Dim sNewKey               As String
    
        'Determine the location/path of the user's MyDocuments folder
        '*******************************************************************************
        Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")
        '    sPath = "TheFullPathOfYourTrustedLocation"        'ie: c:\databases\
        '    sDescription = "YourTrustedLocationDescriptionGoesHere"
        '    bAllowSubFolders = True
        bAlreadyExists = 0
    
        'Determine the current verion of the App
        sAppVer = GetAppVersion(sAppExe)                  '   Returns: 12.0.6720.5000
        sAppVer = ExtractNthTerm(sAppVer, ".", 1) & "." & ExtractNthTerm(sAppVer, ".", 2)
        'Build the corresponding RegKeyPath
        Select Case sAppExe
            Case "msaccess.exe"
                sApp = "Access"
            Case "winword.exe"
                sApp = "Word"
            Case "excel.exe"
                sApp = "Excel"
        End Select
        sParentKey = "Software\Microsoft\Office\" & sAppVer & "\" & sApp & "\Security\Trusted Locations"
        '    sParentKey = "Software\Microsoft\Office\12.0\Access\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\Excel\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\PowerPoint\Security\Trusted Locations"
        '   sParentKey = "Software\Microsoft\Office\12.0\Word\Security\Trusted Locations"
    
        iLocCounter = 0
        oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys
        For Each sChildKey In arrChildKeys
            oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue
            If sValue = sDescription Then bAlreadyExists = True
    
            If CInt(Mid(sChildKey, 9)) > iLocCounter Then
                iLocCounter = CInt(Mid(sChildKey, 9))
            End If
        Next
    
        'Uncomment the following 4 linesif your wish to enable network locations as Trusted
        '   Locations
        '   bAllowNetworkLocations = True
        If bAllowNetworkLocations = -1 Then
            oRegistry.SetDWORDValue HKEY_CURRENT_USER, sParentKey, "AllowNetworkLocations", 1
        End If
    
        If bAlreadyExists = 0 Then
            sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1)
    
            oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey
            oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath
            oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription
    
            If bAllowSubFolders = -1 Then
                oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1
            End If
        End If
    
    Error_Handler_Exit:
        On Error Resume Next
        Set oRegistry = Nothing
        Exit Function
    
    Error_Handler:
        LogError Err.Number, Err.Description, sModName & "/CreateTL", , True
        Resume Error_Handler_Exit
    End Function


    'GetAppVersion("winword.exe")
    '   Returns: 12.0.6720.5000
    Function GetAppVersion(sAppExe As String) As String
        On Error GoTo Error_Handler
        Const HKEY_LOCAL_MACHINE = &H80000002
        Dim oRegistry
        Dim oFSO
        Dim sKey
        '    Dim sAppExe
        Dim sValue
    '    Dim sAppVersion
    
        Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/default:StdRegProv")
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        sKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"
        'sAppExe = "excel.exe"
        'sAppExe = "GROOVE.exe"
        'sAppExe = "infopath.exe"
        '    sAppExe = "MSACCESS.EXE"
        'sAppExe = "MSPUB.EXE"
        'sAppExe = "OneNote.exe"
        'sAppExe = "OUTLOOK.EXE"
        'sAppExe = "winword.exe"
        'sAppExe = "firefox.exe" 'Even works with a number of other programs!
        oRegistry.GetStringValue HKEY_LOCAL_MACHINE, sKey & "\" & sAppExe, "", sValue
        GetAppVersion = oFSO.GetFileVersion(sValue)
    
    Error_Handler_Exit:
        On Error Resume Next
        Set oFSO = Nothing
        Set oRegistry = Nothing
        Exit Function
    
    Error_Handler:
        LogError Err.Number, Err.Description, sModName & "/GetAppVersion", , True
        Resume Error_Handler_Exit
    End Function

    One precision, in my code, and a lot of other code you'll see us creating TL with sequential names

    • Location0
    • Location1
    • Location2
    • and so on

    we are merely following what MS uses, but in reality, you can name it as you like and make it more meaningful!


    Daniel Pineault, 2010-2016 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net






    Sunday, January 22, 2017 4:12 PM
  • i test inno setup and auto run pro for packing.but no one had these features.what is your suggestion?

    microsoft


    Hi, I use SSE Setup but even Inno Setup can do it because all you need to do is write a script to add a Trusted Location.
    Sunday, January 22, 2017 4:33 PM
  • Hi, This looks like a continuation of this previous discussion: https://social.msdn.microsoft.com/Forums/en-US/e0fa8c16-752c-41b2-b96f-eae92dfd9144/how-could-i-create-a-trusted-location-on-the-customer-system?forum=accessdev
    Sunday, January 22, 2017 4:35 PM
  • thanks al ot.

    microsoft

    Monday, January 23, 2017 7:10 AM
  • thanks so much daniel .

    microsoft

    Monday, January 23, 2017 7:12 AM
  • thanks al ot.

    microsoft

    Hi,

    You're welcome. Glad to hear you're all good now. Good luck with your project.

    Monday, January 23, 2017 3:43 PM