폴더가 변경 될 때 동일한 폴더에서 Access DBS 용 링크 된 테이블 보존

https://stackoverflow.com/questions/534102

22-08-2019
|

문제

연결된 테이블을 공유하는 액세스 데이터베이스가 두 개 있습니다. 디렉토리로 함께 배치되어 코드를 통해 단어 형식으로 액세스합니다.

두 데이터베이스가 다른 폴더에 (함께) 복사 될 때 링크가 보존되도록하려면 어떻게해야합니까? 데이터베이스를 "오픈"하지 않기 때문에 (ADO를 통해 액세스되고 있음) 링크를 새로 고치기 위해 코드를 작성하는 방법을 모르겠습니다.

해결책

업데이트 14APR2009내가 여기에 준 이전 답변이 잘못되었으므로 새 코드로 업데이트했습니다.

진행 방법

아래 코드를 VBA 모듈로 복사하십시오.
코드에서 또는 즉각적인 VBA IDE의 창은 간단히 입력합니다.
```
RefreshLinksToPath Application.CurrentProject.Path
```

이제 모든 링크 된 테이블을 다시 링크하여 응용 프로그램이있는 디렉토리를 사용합니다.
새로운 테이블을 다시 링크하거나 추가 할 때마다 한 번만 수행하면됩니다.
응용 프로그램을 시작할 때마다 코드 에서이 작업을 수행하는 것이 좋습니다.
그런 다음 문제없이 데이터베이스를 이동할 수 있습니다.

암호

'------------------------------------------------------------'
' 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.             '
'------------------------------------------------------------'
Public Function RefreshLinksToPath(strNewPath As String, _
    Optional OnlyForTablesMatching As String = "*") As Boolean

    Dim collTbls As New Collection
    Dim i As Integer
    Dim strDBPath As String
    Dim strTbl As String
    Dim strMsg As String
    Dim strDBName As String
    Dim strcon As String
    Dim dbCurr As DAO.Database
    Dim dbLink As DAO.Database
    Dim tdf As TableDef

    Set dbCurr = CurrentDb

    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
                collTbls.Add Item:=.Name & .Connect, key:=.Name
            End If
        End With
    Next
    Set tdf = Nothing

    ' Now link all of them'
    For i = collTbls.count To 1 Step -1
        strcon = collTbls(i)
        ' Get the original name of the linked table '
        strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8))
        ' Get table name from connection string '
        strTbl = Left$(strcon, InStr(1, strcon, ";") - 1)
        ' Get the name of the linked database '
        strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))

        ' Reconstruct the full database path with the given path '
        strDBPath = strNewPath & "\" & strDBName

        ' Reconnect '
        Set tdf = dbCurr.TableDefs(strTbl)
        With tdf
            .Connect = ";Database=" & strDBPath
            .RefreshLink
            collTbls.Remove (.Name)
        End With
    Next
    RefreshLinksToPath = True

fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdf = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function

fRefreshLinks_Err:
    RefreshLinksToPath = False
    Select Case Err
        Case 3059:

        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg
            Resume fRefreshLinks_End
    End Select
End Function

이 코드는이 소스에서 조정됩니다. http://www.mvps.org/access/tables/tbl0009.htm.
나는 다른 기능에 대한 모든 의존성을 제거하여 독립적 인 기능을 만들었습니다. 그래서 그것이 예정보다 조금 더 길어집니다.

다른 팁

단어 양식 내에서 링크를 업데이트하거나 액세스 데이터베이스 간의 링크 된 테이블 링크를 언급하고 있습니까?

전자의 경우, 내가 아는 가장 좋은 방법은 Word Document/VBA 프로젝트 내의 모듈 레벨에서 연결 문자열을 유지하고 Const 문자열을 만드는 것입니다. 그런 다음 ADO 연결 개체의 연결 문자열을 설정할 때 상대 연결 문자열 Const를 전달하십시오.

후자의 경우, 각 액세스 데이터베이스 내의 데이터로 연결 문자열에서 상대 경로를 사용하여 상대 경로를 사용하고 싶은 유혹을받습니다. 예를 들어,

Dim connectionString as String

connectionString = ";DATABASE=" & CurrentProject.Path & "\[Database Name Here].mdb"

당신이 말했듯이, 데이터베이스가 다른 폴더에 함께 복사됩니다 (나는 가정합니다 동일한 폴더로).

Renaud의 답변은 더 이상 Excel 또는 CSV 파일로 Access 2010에서 작동하지 않습니다.

몇 가지 수정을했습니다.

연결 문자열의 현재 패턴에 적합합니다
Excel 파일 (파일 이름 포함) 및 CSV 파일에 대해 데이터베이스 경로를 다르게 처리했습니다 (파일 이름 포함)

코드는 다음과 같습니다.

Public Function RefreshLinksToPath(strNewPath As String, _
Optional OnlyForTablesMatching As String = "*") As Boolean

Dim collTbls As New Collection
Dim i As Integer
Dim strDBPath As String
Dim strTbl As String
Dim strMsg As String
Dim strDBName As String
Dim strcon As String
Dim dbCurr As DAO.Database
Dim dbLink As DAO.Database
Dim tdf As TableDef

Set dbCurr = CurrentDb

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
            Debug.Print "Name: " & .Name
            Debug.Print "Connect: " & .Connect
            collTbls.Add Item:=.Name & ";" & .Connect, Key:=.Name
        End If
    End With
Next
Set tdf = Nothing

' Now link all of them'
For i = collTbls.Count To 1 Step -1
    strConnRaw = collTbls(i)
    ' Get table name from the full connection string
    strTbl = Left$(strConnRaw, InStr(1, strConnRaw, ";") - 1)
    ' Get original database path
    strDBPath = Right(strConnRaw, Len(strConnRaw) - (InStr(1, strConnRaw, "DATABASE=") + 8))
    ' Get the name of the linked database
    strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))
    ' Get remainder of connection string
    strConn = Mid(strConnRaw, InStr(1, strConnRaw, ";") + 1, InStr(1, strConnRaw, "DATABASE=") _
                - InStr(1, strConnRaw, ";") - 1)

    ' Reconstruct the full database path with the given path
    ' CSV-Files are not linked with their name!
    If Left(strConn, 4) = "Text" Then
        strDBPath = strNewPath
    Else
        strDBPath = strNewPath & "\" & strDBName
    End If

    ' Reconnect '
    Set tdf = dbCurr.TableDefs(strTbl)
    With tdf
        .Connect = strConn & "Database=" & strDBPath
        .RefreshLink
        collTbls.Remove (.Name)
    End With
Next
RefreshLinksToPath = True

fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdf = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function

fRefreshLinks_Err:
    RefreshLinksToPath = False
    Select Case Err
        Case 3059:

        Case Else:
            strMsg = "Error Information..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
            strMsg = strMsg & "Description: " & Err.Description & vbCrLf
            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg
            Resume fRefreshLinks_End
    End Select
End Function

나는 불행히도 여전히 Access 2007에 있습니다. 나는 위의 코드 블록 중 하나를 시작하여 나에게 효과가 없었습니다. 액세스가 적을수록 VBA 전원은 테이블 경로를 가져 와서 업데이트하는 첫 번째 루프 만 단순화했습니다. 다음 에이 사람이 댓글을 달거나 업데이트 할 수 있습니다.

옵션 데이터베이스 비교

'------------------------------------------------------------'
' 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

라이센스 : CC-BY-SA ~와 함께 속성

제휴하지 않습니다 StackOverflow