How can I add a certificate to VBA Access project

Question

I am trying to get an Access 2000 database to run in the Access 2010 runtime and remove the warning dialog about the file not being trusted. I have done some research and discovered the SelfCert.exe program. This is a good tutorial on certificates. And this, too. Even Microsoft had instructions for Access 2000 indicating that this menu item should exist. However, my Tools menu in the Access 2000 VBA IDE does not have the Digital Signature menu item. What's worse is that when I right-click on menu bar to customize the Tools menu, I do see the Digital Signature... item in the customize list. When I click and drag to add it to the Tools menu, it disregards my command. How stubborn! If I click and drag anything else to the Tools menu, it works like a charm. What?!

How do I install that menu item? Or, better yet, how do I get my database not to have the security warning when I open it from Access 2010 runtime?

Answer 1

Access 2000 do not support this, this feature was only added in Access 2003.

Answer 2

After some more significant research, I discovered the answer to my second question, which was ultimately what I wanted an answer to. How do I get rid of the potential security concern dialog when opening an Access 2000 database in the Access 2010 runtime?

Basically, you need to add the database to the list of trusted locations. The Access 2010 runtime does not offer a UI for this feature, so you have to do it programmatically. This website offers the code: Utter Access Add Trusted Location

I modified it for the specific requirements in this situation. Run an Access 2000 database in Access 2010 runtime. You will need to modify it for other versions of the runtime depending on the registry settings. Also, I read that this will not work in Windows 8. But I also found that you do NOT need administrative privileges to run this code because it only modifies the HKEY_CURRENT_USER hive in the registry, which the current user has full access to.

Public Function AddTrustedLocation()
On Error GoTo err_proc
'WARNING:  THIS CODE MODIFIES THE REGISTRY
'You do not need administrator privileges
'since it only affects the HK_CURRENT_USER hive
'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
Dim strTitle As String

strTitle = "Add Trusted Location"
Set reg = CreateObject("wscript.shell")
strPath = CurrentProject.path

'Specify the registry trusted locations path for the Access 2010 runtime
strLnKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.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 the registry location is unused 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, strTitle
        GoTo exit_proc
    End If
    'if no unused location found then set new location for path
    If intNotUsed = 0 Then intNotUsed = i + 1

    'Write Trusted Location regstry key to unused location in registry
    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:
      If intNotUsed = 0 Then intNotUsed = intLocns
      Resume NextLocn

err_proc:
      MsgBox Err.Description, , strTitle
      Resume exit_proc

End Function

I added this function to the AutoExec macro. When the user first logs on, they do receive the security notice; however, it will never appear again as long as the document remains in the trusted location it was first run at. Woo-hoo!

Answer 3

The accepted answer here is what I was looking for but the code provided was too far gone so I rewrote most of it. If you come here looking for code, take a look at my solution. It dynamically works with any version of Access. It allows network locations. The main sub accepts variables so that you can trust any given location. There is a TrustCurrentProject sub that will do what @Bobort wanted.

Option Compare Database
Option Explicit
'
' TrustIssues by HackSlash 2019-01-21
'   Use this module to trust Access paths
'   Removes those annoying security pop-ups
'
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7

' Returns a collection of sub-keys from the given hive\key passed in
Public Function EnumerateKeys(ByVal hive As Variant, ByVal key As String) As Collection
    Set EnumerateKeys = New Collection

    Dim reg As Object
    Set reg = GetObject("winmgmts://./root/default:StdRegProv")
    Dim allSubKeys As Variant
    reg.EnumKey hive, key, allSubKeys
    If Not IsNull(allSubKeys) Then
        Dim subkey As Variant
        For Each subkey In allSubKeys
            EnumerateKeys.Add subkey
        Next
    End If
End Function

' Adds registry key for  new trusted location.
Public Sub AddTrustedLocation(ByVal locName As String, ByVal trustPath As String, ByVal descript As String)
    ' WARNING:  THIS CODE MODIFIES THE REGISTRY
    ' You do not need administrator privileges since it only affects HKEY_CURRENT_USER

    On Error GoTo err_proc

    ' Get version of Access that is running now
    Dim version As String
    version = Application.SysCmd(acSysCmdAccessVer)

    ' Specify the registry trusted locations path for the Access runtime based on the detected version
    Dim regKeyPath As String
    regKeyPath = "Software\Microsoft\Office\" & version & "\Access\Security\Trusted Locations"

    ' Collect all the currently trusted locations
    Dim trustedLocations As Collection
    Set trustedLocations = EnumerateKeys(HKEY_CURRENT_USER, regKeyPath)

    Dim registry As Object
    Set registry = GetObject("winmgmts://./root/default:StdRegProv")

    ' Turn on "Allow Netowrk Locations"
    registry.SetDWORDValue HKEY_CURRENT_USER, regKeyPath, "AllowNetworkLocations", 1

    ' Check if the path is already a trusted location
    Dim locKey As Variant
    For Each locKey In trustedLocations
        If locKey = locName Then Exit Sub

        On Error Resume Next
        Dim thePath As String
        Debug.Print registry.GetStringValue(HKEY_CURRENT_USER, regKeyPath & "\" & locKey, "Path", thePath)

        If thePath = trustPath Then Exit Sub
    Next locKey

    On Error GoTo err_proc
    ' Write Trusted Location regstry key to specified location
    regKeyPath = regKeyPath & "\" & locName
    Debug.Print registry.CreateKey(HKEY_CURRENT_USER, regKeyPath)
    Debug.Print registry.SetDWORDValue(HKEY_CURRENT_USER, regKeyPath, "AllowSubfolders", 1)
    Debug.Print registry.SetStringValue(HKEY_CURRENT_USER, regKeyPath, "Date", CStr(Date))
    Debug.Print registry.SetStringValue(HKEY_CURRENT_USER, regKeyPath, "Description", descript)
    Debug.Print registry.SetStringValue(HKEY_CURRENT_USER, regKeyPath, "Path", trustPath)         

err_proc:
    If Err.Number <> 0 Then MsgBox Err.Description, , "ERROR while trusting this project"

End Sub

Public Sub TrustCurrentProject()
    AddTrustedLocation Replace(CurrentProject.Name, " ", vbNullString), CurrentProject.Path, CurrentProject.Name
End Sub