问题
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?
回答1:
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!
回答2:
Access 2000 do not support this, this feature was only added in Access 2003.
回答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
来源：https://stackoverflow.com/questions/17409158/how-can-i-add-a-certificate-to-vba-access-project-if-the-digital-signature-item