Access数据库VB连接认证失败，GetKeyID函数.Open报错求助

问题现象 #

首次使用Microsoft Access创建数据库整合多个Excel数据时，执行自定义函数触发认证失败错误，调试指向GetKeyID函数中的.Open语句。

核心错误分析 #

• 错误的数据库文件路径：GetKeyID中连接了Access的临时锁文件.laccdb，这是Access用于锁定数据库的临时文件，无法作为数据源连接，需替换为实际的.accdb文件。
• 未定义变量引用：GetKeyID中.ConnectionString = DataSource，但函数内未声明DataSource变量，实际应使用已定义的dbPath。
• 无效的查询执行逻辑：GetHeaderID中仅创建了记录集对象但未执行查询，且GetKeyID混用了未关联当前连接的ConnCmd对象，导致查询无法正确执行。
• 重复创建连接：每个函数都单独创建数据库连接，不仅效率低，还容易引发连接冲突，应复用主过程的连接对象。
• SQL注入风险：直接拼接字符串生成SQL语句，若内容含特殊字符会导致语法错误，同时存在安全隐患，需改用参数化查询。

修复后的完整代码 #

Option Explicit ' 强制声明所有变量，避免隐式声明错误

Sub TestTransferDataToAccess()
    Dim ConnObj As ADODB.Connection
    Dim ConnCmd As ADODB.Command
    Dim DataSource As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim headerID As Long
    Dim keyID As Long
    Dim torqueValue As Double
    Dim row As Long
    
    ' 数据库路径
    DataSource = "O:\Department\Engineering\Einstein\00 - Systems Engineering\04 - Databases\VerificationLogDB.accdb"
    
    ' 创建并打开数据库连接
    Set ConnObj = New ADODB.Connection
    With ConnObj
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & DataSource & ";"
        .Open
    End With
    
    ' 初始化命令对象
    Set ConnCmd = New ADODB.Command
    ConnCmd.ActiveConnection = ConnObj
    
    ' 打开Excel文件
    Set wb = Workbooks.Open("O:\Swap\Chicago\GenoF\Reading-2021-03-22-10-14-48.xls")
    Set ws = wb.Sheets("As Found-CW Data")
    
    ' 循环读取Excel数据并插入Access
    For row = 16 To 25
        headerID = GetHeaderID(ConnObj, ws.Cells(row, 2).Value)
        keyID = GetKeyID(ConnObj, "Channel 1")
        torqueValue = CDbl(ws.Cells(row, 3).Value)
        
        ' 参数化插入查询，避免SQL注入
        With ConnCmd
            .CommandText = "INSERT INTO tblTorqueData (headerID, keyID, torqueValue) VALUES (?, ?, ?)"
            .Parameters.Append .CreateParameter(, adInteger, adParamInput, , headerID)
            .Parameters.Append .CreateParameter(, adInteger, adParamInput, , keyID)
            .Parameters.Append .CreateParameter(, adDouble, adParamInput, , torqueValue)
            .Execute
            .Parameters.Delete ' 清空参数，用于下一次循环
        End With
    Next row
    
    ' 关闭资源
    wb.Close SaveChanges:=False ' 关闭Excel文件，不保存修改
    ConnObj.Close
    Set ConnCmd = Nothing
    Set ConnObj = Nothing
    
    MsgBox "Data transfer to Access completed."
End Sub

Function GetHeaderID(conn As ADODB.Connection, headerName As String) As Long
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    
    ' 参数化查询获取HeaderID
    strSQL = "SELECT HeaderID FROM tblHeaders WHERE HeaderName = ?"
    
    Set rs = New ADODB.Recordset
    With rs
        .Open strSQL, conn, adOpenForwardOnly, adLockReadOnly, adCmdText
        .Parameters.Append .CreateParameter(, adVarChar, adParamInput, 255, headerName) ' 假设HeaderName字段长度255
        
        If Not .EOF Then
            GetHeaderID = .Fields(0).Value
        Else
            GetHeaderID = -1 ' 未找到时返回默认值
        End If
        .Close
    End With
    
    Set rs = Nothing
End Function

Function GetKeyID(conn As ADODB.Connection, keyName As String) As Long
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    
    ' 参数化查询获取KeyID
    strSQL = "SELECT KeyID FROM tblKeys WHERE KeyName = ?"
    
    Set rs = New ADODB.Recordset
    With rs
        .Open strSQL, conn, adOpenForwardOnly, adLockReadOnly, adCmdText
        .Parameters.Append .CreateParameter(, adVarChar, adParamInput, 255, keyName) ' 假设KeyName字段长度255
        
        If Not .EOF Then
            GetKeyID = .Fields(0).Value
        Else
            GetKeyID = -1 ' 未找到时返回默认值
        End If
        .Close
    End With
    
    Set rs = Nothing
End Function

额外注意事项 #

• 确保已引用Microsoft ActiveX Data Objects x.x Library（在VBA编辑器中：工具→引用，选择对应版本）。
• 检查文件路径权限：确保当前用户对Access数据库路径和Excel文件路径有读写权限。
• 若数据库已被其他用户打开，需确认未处于独占模式，否则会导致连接失败。

内容的提问来源于stack exchange，提问作者St3althPatchin