MS Access AutoExec执行RunCode抛出2001错误求助

错误根源 #

出现错误2001（无法运行RefreshODBCLinks操作），核心原因包括：

• API函数未声明：GetUserName和GetComputerName调用Windows系统API，但代码缺少必要声明，其他用户打开数据库时会触发编译错误，导致AutoExec宏执行中断。
• 无错误捕获机制：RefreshODBCLinks和RefreshTableLinks未处理连接失败、权限不足等异常，直接抛出未处理错误。
• 占位符未替换：连接字符串中的<SERVER_NAME>、<USERNAME>等占位符未替换为真实信息，导致SQL Server连接失败。
• 未过滤系统表：遍历所有TableDef时包含Access系统表（如MSys开头的表），修改系统表属性会引发错误。

修复步骤 #

1. 补充API函数声明 #

在模块顶部添加兼容32/64位的API声明：

#If VBA7 Then
    Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Declare PtrSafe Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
    Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If

2. 完善错误处理与过滤逻辑 #

修改RefreshODBCLinks函数，添加错误捕获并仅处理合法链接表：

Function RefreshODBCLinks()
    On Error GoTo ErrHandle
    Dim newConnectionString As String

    ' 替换为真实SQL Server连接信息
    newConnectionString = "DRIVER=SQL Server;" & _
                          "SERVER=你的服务器名称;" & _
                          "UID=你的数据库用户名;" & _
                          "PWD=你的数据库密码;" & _
                          "APP=Microsoft Office;" & _
                          "DATABASE=你的目标数据库名;" & _
                          "Network=DBMSSOCN"

    Dim db As DAO.Database
    Dim tb As DAO.TableDef

    Set db = CurrentDb

    For Each tb In db.TableDefs
        ' 过滤系统表与本地表，仅处理目标ODBC链接表
        If tb.Connect <> "" And InStr(tb.Connect, "你的目标数据库名") > 0 And Left(tb.Name, 4) <> "MSys" Then
            tb.Connect = newConnectionString
            tb.Attributes = dbAttachSavePWD
            tb.RefreshLink
            Debug.Print "刷新ODBC表: " & tb.Name
        End If
    Next tb

ExitHandle:
    Set tb = Nothing
    Set db = Nothing
    Exit Function

ErrHandle:
    MsgBox "刷新ODBC链接失败: " & Err.Description & " (错误编号: " & Err.Number & ")", vbExclamation
    Resume ExitHandle
End Function

修改RefreshTableLinks函数，仅处理非系统链接表：

Public Function RefreshTableLinks() As String
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim tdf As DAO.TableDef

Set db = CurrentDb

For Each tdf In db.TableDefs
    ' 仅处理非系统的ODBC链接表
    If tdf.Connect <> "" And Left(tdf.Name, 4) <> "MSys" Then
        tdf.Name = Replace(tdf.Name, "dbo_", "")
        tdf.RefreshLink
    End If
Next tdf

RefreshTableLinks = "链接表刷新完成"

ErrHandle:
If Err.Number <> 0 Then
    RefreshTableLinks = "刷新失败: " & Err.Description & " (错误编号: " & Err.Number & ")"
    MsgBox RefreshTableLinks, vbExclamation
End If
Set tdf = Nothing
Set db = Nothing
Exit Function
End Function

3. 替换连接字符串占位符 #

务必将newConnectionString中的占位符替换为真实的SQL Server服务器地址、用户名、密码及数据库名称，否则会直接导致连接失败。

4. 验证用户权限与连接 #

确保所有使用该数据库的用户都具备目标SQL Server数据库的访问权限，可通过ODBC数据源管理器提前测试客户端到服务器的连接是否正常。

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