Preserving linked tables for Access DBs in same folder when the folder changes

前端 未结 4 1531
陌清茗
陌清茗 2020-12-30 11:40

I\'ve got two Access databases that share linked tables. They are deployed together in a directory and accessed via code in a Word form.

How can I make sure that the

4条回答
  •  慢半拍i
    慢半拍i (楼主)
    2020-12-30 12:18

    I am unfortunately still on Access 2007. I started with one of the code blocks above which was not working for me. Having less access vba power I simplified it to only the first loop which gets the table paths and updates it in place. The next guy running into this can comment or update.

    Option Compare Database

    '------------------------------------------------------------'
    ' Reconnect all linked tables using the given path.          '
    ' This only needs to be done once after the physical backend '
    ' has been moved to another location to correctly link to    '
    ' the moved tables again.                                    '
    ' If the OnlyForTablesMatching parameter is given, then      '
    ' each table name is tested against the LIKE operator for a  '
    ' possible match to this parameter.                          '
    ' Only matching tables would be changed.                     '
    ' For instance:                                              '
    ' RefreshLinksToPath(CurrentProject.Path, "local*")          '
    ' Would force all tables whose ane starts with 'local' to be '
    ' relinked to the current application directory.             '
    '
    ' Immediate window type
    ' RefreshLinksToPath Application.CurrentProject.Path
    
    '------------------------------------------------------------'
    Public Function RefreshLinksToPath(strNewPath As String, _
        Optional OnlyForTablesMatching As String = "*") As Boolean
    
        Dim strDBPath As String
        'Dim strTbl As String
        'Dim strMsg As String
        Dim strDBName As String
        Dim dbCurr As DAO.Database
        Dim dbLink As DAO.Database
        Dim tdf As TableDef
    
        Set dbCurr = CurrentDb
        Dim strConn As String
        Dim strNewDbConn1 As String
        Dim strNewDbConn2 As String
        Dim strNewDbConn  As String
    
        '  On Local Error GoTo fRefreshLinks_Err
    
        'First get all linked tables in a collection'
        dbCurr.TableDefs.Refresh
        For Each tdf In dbCurr.TableDefs
            With tdf
                If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _
                   And (.Name Like OnlyForTablesMatching) Then
    
                    strConn = tdf.Connect
                    strDBPath = Right(strConn, Len(strConn) - (InStr(1, strConn, "DATABASE=") + 8))
                    strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))
                    Debug.Print ("===========================")
                    Debug.Print (" connect is " + strConn)
                    Debug.Print (" DB PAth is " + strDBPath)
                    Debug.Print (" DB Name is " + strDBName)
    
                    strDBNewPath = strNewPath & "\" & strDBName
                    Debug.Print (" DB NewPath is " + strDBNewPath)
    
                    strNewDbConn1 = Left(strConn, (InStr(1, strConn, "DATABASE=") - 1))
                    strNewDbConn2 = "DATABASE=" & strDBNewPath
                    strNewDbConn = strNewDbConn1 & strNewDbConn2
                    Debug.Print (" DB strNewDbConn is " + strNewDbConn)
    
                    'Change the connect path
                    tdf.Connect = strNewDbConn
                    tdf.RefreshLink
                End If
            End With
        Next
    End Function
    

提交回复
热议问题