Check trusted path in registry

[tuxalot]

I have a function tied to my main forms on open event that adds the current db path as a trusted location to avoid the macro warnings each time the db is opened:

Function MakeTrustedLocation()
On Error GoTo ET
 
        Dim strFile As String, strLocation As String, strKey As String, strSql As String, strMsg As String
 
        strKey = "[HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\MyTrustedPath]"
 
        strLocation = Application.CurrentProject.Path & "\"
        strLocation = Replace(strLocation, "\", "\\")
        strFile = "C:\TEMP\TrustMyApplication.reg"
        Open strFile For Output As #1
        Print #1, "Windows Registry Editor Version 5.00"
        Print #1, ""
        Print #1, strKey
        Print #1, """Path""=""" & strLocation & """"
        Print #1, """AllowSubfolders""=dword:00000001"
        Close #1
        Shell ("regedit /s " & strFile)
        Kill (strFile)
        Exit Function
ET:
        strMsg = Err.Number & " - " & Err.Description
        Debug.Print strMsg
 
End Function
 

No need to execute this code each time the main form opens. So I would like to check if the registry entry exists and is equal to the current db path. If so, then exit function.

Thanks for the look,

Tux

[DonRayner]

Hey Tux;

There is a class module that you can download and add to your project, called cRegistry. This module will allow you to do just about whatever you want with the registry.

Instructions for it's use and a link to download are here.

[tuxalot]

Thanks Don. How does this class module integrate into Access VBA? In the meantime, here is my solution:

'--- reads the value for the registry key strChkKey.  if the key cannot be found, the return value is ""
 
Function RegKeyRead()
'On Error GoTo ET
 
Dim myWS As Object
Dim RegKeyMe As String
Dim strAppPath As String
Dim strChkKey As String
 
'--- store the path of the current registry key in variable if key is present
strChkKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\HyattInjuryDb\Path"
 
'--- try to read the reg key
On Error GoTo NewKey
'--- use Windows scripting to read the registry key
Set myWS = CreateObject("WScript.Shell")
myWS.RegRead (strChkKey) ' if key does not exist, an error will result.  in this case, create a new key
 
'--- store the full path to our current project
strAppPath = CurrentProject.Path & "\"
 
'--- read key from registry and store in variable RegKeyMe
  RegKeyMe = myWS.RegRead(strChkKey)
 
'--- MsgBox RegKeyMe, , "RegKeyMe"
'--- MsgBox strAppPath, , "strAppPath"
 
If RegKeyMe <> strAppPath Then
 
NewKey:
 
'--- MsgBox "need to add new reg key"
 
        Dim strFile As String, strLocation As String, strKey As String, strSql As String, strMsg As String
 
        strKey = "[HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\HyattInjuryDb]"
 
        strLocation = Application.CurrentProject.Path & "\"
        strLocation = Replace(strLocation, "\", "\\")
        strFile = "C:\TEMP\TrustMyApplication.reg"
        Open strFile For Output As #1
        Print #1, "Windows Registry Editor Version 5.00"
        Print #1, ""
        Print #1, strKey
        Print #1, """Path""=""" & strLocation & """"
        Print #1, """AllowSubfolders""=dword:00000001"
        Close #1
        Shell ("regedit /s " & strFile)
        Kill (strFile)
        Exit Function
 
    Else
 
'--- MsgBox "key is good to go"
 
    End If
 
ET:
        strMsg = Err.Number & " - " & Err.Description
        Debug.Print strMsg
        Exit Function
 
End Function
 

Thanks

[DonRayner]

Hey Tux,

On the page link that I posted you can copy the text from the module. In your access project create a new class module with the name cRegistry and paste the copied code into it.

The page has all the examples that you need on using the module.

[ADezii]

Just subscribing, will return later.

[ADezii]

Oh well, here I am again. You can use this code to specifically check and see if a Registry Key exists:

1. First, the API Declaration:
   

   Public Declare Function RegOpenKeyEx _
   Lib "advapi32.dll" Alias "RegOpenKeyExA" _
   (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, _
   phkResult As Long) As Long

2. In your specific case:
   

   Dim hKey As Long
   Const conKEY_NAME = "Software\Microsoft\Ofvvfice\12.0\Access\Security\Trusted Locations\MyTrustedPath"
   Const conHKEY_CURRENT_USER = &H80000001
   Const READ_CONTROL = &H20000
   Const STANDARD_RIGHTS_READ = (READ_CONTROL)
   Const KEY_QUERY_VALUE = &H1
   Const KEY_ENUMERATE_SUB_KEYS = &H8
   Const KEY_NOTIFY = &H10
   Const SYNCHRONIZE = &H100000
    
   Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
                      KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And _
                      (Not SYNCHRONIZE))
    
   'Attempt to Open the requested Key
   If RegOpenKeyEx(conHKEY_CURRENT_USER, conKEY_NAME, 0, KEY_READ, hKey) <> 0 Then
     MsgBox "The Registry Key [" & conKEY_NAME & "] does not exist!"
   Else
     MsgBox "The Registry Key [" & conKEY_NAME & "] does exist!"
   End If

[tuxalot]

Thanks again Adezii. I had a thought on this:

I'm only interested in knowing if the project is opening from a trusted location. If the current project path has not been added as a trusted location, the key -

Software\Microsoft\Office\12.0\Access\Security\Tru sted Locations\MyTrustedPath\

would not exist (...\MyTrustedPath is added by my function). However, if the end user has previously set the db path as trusted, then move the db, the directory 'MyTrustedPath' will exist but the Path key will not match the current project path.

So would I need to approach this differently, and perform (2) checks, one to check for the existence of -

Software\Microsoft\Office\12.0\Access\Security\Tru sted Locations\MyTrustedPath\

and next, to check if the reg path key

Software\Microsoft\Office\12.0\Access\Security\Tru sted Locations\MyTrustedPath\ Path

matches the current project path?

Thanks again,

Tux

[ADezii]

@tuxalot
It would appear to me to be a 2-Step process, at least you should be able to isolate the problem should something go wrong.

[tuxalot]

Hi ADezii,

I'm getting an "invalid outside procedure" when compiling using this code. The error is at

    If RegOpenKeyEx(conHKEY_CURRENT_USER, conKEY_NAME, 0, KEY_READ, hKey) <> 0 Then
 

Ideas?

[ADezii]

@tuxalot
The code is sound, I need to see the entire code context (the Procedure in which the Registry Key is Opened), as well as the API Declaration and where it is Declared RegOpenKeyEX().