复制到不同机器时如何在 Access 中保留链接表

问题描述

我们有一个 Access DB，其中包含 1000 多个链接表和大约 200 个本地表。 我们需要这个 Access DB 驻留在大约 40 个用户的桌面上。 问题是，每次我将 Access 文件复制到新 PC 时，即使链接表的 ODBC 连接名称相同，它也总是要求我重新链接所有 1000 多个表，并且我必须单击确定 1000 多次。

有没有办法以这样一种方式保存文件，即保留链接关系和 ODBC 名称，以便我可以轻松地将它从一台机器复制到另一台机器？

解决方法

使用无 DSN 连接和函数重新链接（只需要切换数据库）所有表和传递查询：

Public Function AttachSqlServer( _
    ByVal Hostname As String,_
    ByVal Database As String,_
    ByVal Username As String,_
    ByVal Password As String) _
    As Boolean

' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS,CPH.

    Const cstrDbType    As String = "ODBC"
    Const cstrAcPrefix  As String = "dbo_"

    Dim dbs             As DAO.Database
    Dim tdf             As DAO.TableDef
    Dim qdf             As DAO.QueryDef
    
    Dim strConnect      As String
    Dim strName         As String
    
    On Error GoTo Err_AttachSqlServer
    
    Set dbs = CurrentDb
    strConnect = ConnectionString(Hostname,Database,Username,Password)
    
    For Each tdf In dbs.TableDefs
        strName = tdf.Name
        If Asc(strName) <> Asc("~") Then
            If InStr(tdf.Connect,cstrDbType) = 1 Then
                If Left(strName,Len(cstrAcPrefix)) = cstrAcPrefix Then
                    tdf.Name = Mid(strName,Len(cstrAcPrefix) + 1)
                End If
                tdf.Connect = strConnect
                tdf.RefreshLink
                Debug.Print Timer,tdf.Name,tdf.SourceTableName,tdf.Connect
                DoEvents
            End If
        End If
    Next
    
    For Each qdf In dbs.QueryDefs
        If qdf.Connect <> "" Then
            Debug.Print Timer,qdf.Name,qdf.Type,qdf.Connect
            qdf.Connect = strConnect
        End If
    Next
    Debug.Print "Done!"
    
    AttachSqlServer = True
    
Exit_AttachSqlServer:
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function
    
Err_AttachSqlServer:
    Call ErrorMox
    Resume Exit_AttachSqlServer
    
End Function



Public Function ConnectionString( _
    ByVal Hostname As String,_
    ByVal Password As String,_
    Optional ByVal AdoStyle As Boolean) _
    As String

' Create ODBC or ADO connection string from its variable elements.
' 2021-06-15. Cactus Data ApS,CPH.

    Const AzureDomain   As String = ".windows.net"
    Const OdbcPrefix    As String = "ODBC;"
    Const OdbcConnect   As String = _
        "DRIVER=SQL Server Native Client 11.0;" & _
        "Description=Cactus TimeSag og Finans;" & _
        "APP=Microsoft® Access;" & _
        "SERVER={0};" & _
        "DATABASE={1};" & _
        "UID={2};" & _
        "PWD={3};" & _
        "Trusted_Connection={4};"
        
    Dim FullConnect     As String
    
    If Right(Hostname,Len(AzureDomain)) = AzureDomain Then
        ' Azure SQL connection.
        ' Append servername to username.
        Username = Username & "@" & Split(Hostname)(0)
    End If
    If Not AdoStyle Then
        FullConnect = OdbcPrefix
    End If
    FullConnect = FullConnect & OdbcConnect
    FullConnect = Replace(FullConnect,"{0}",Hostname)
    FullConnect = Replace(FullConnect,"{1}",Database)
    FullConnect = Replace(FullConnect,"{2}",Username)
    FullConnect = Replace(FullConnect,"{3}",Password)
    FullConnect = Replace(FullConnect,"{4}",IIf(Username & Password = "","Yes","No"))
    
    ConnectionString = FullConnect

End Function

另外，研究我的文章：Deploy and update a Microsoft Access application with one click