Ref: Relinking ODBC Tables using VBA
I have tested this but it does not seem to work for me. My question: Is the strDBName the database name I have to modify to suit my main database? Like "myAccess.mdb"
Is it rude to ask for an example mdb?
Comment NeoPa
Expand|Select|Wrap|Line Numbers
- 'ReLink() Updates links of all tables that currently link to strDBName to point
- 'to strDBName in the strFolder folder (if specified, otherwise the same folder
- 'as the current database).
- Public Sub ReLink(ByVal strDBName As String, _
- Optional ByVal strFolder As String = "")
- Dim intParam As Integer, intErrNo As Integer
- Dim strOldLink As String, strOldName As String
- Dim strNewLink As String, strMsg As String
- Dim varLinkAry As Variant
- Dim db As DAO.Database
- Dim tdf As DAO.TableDef
- Set db = CurrentDb()
- If strFolder = "" Then strFolder = CurrentProject.Path
- If Right(strFolder, 1) = "\" Then _
- strFolder = Left(strFolder, Len(strFolder) - 1)
- strNewLink = strFolder & "\" & strDBName
- For Each tdf In db.TableDefs
- With tdf
- If .Attributes And dbAttachedTable Then
- varLinkAry = Split(.Connect, ";")
- For intParam = LBound(varLinkAry) To UBound(varLinkAry)
- If Left(varLinkAry(intParam), 9) = "DATABASE=" Then Exit For
- Next intParam
- strOldLink = Mid(varLinkAry(intParam), 10)
- If strOldLink <> strNewLink Then
- strOldName = Split(strOldLink, _
- "\")(UBound(Split(strOldLink, "\")))
- If strOldName = strDBName Then
- varLinkAry(intParam) = "DATABASE=" & strNewLink
- .Connect = Join(varLinkAry, ";")
- On Error Resume Next
- Call .RefreshLink
- intErrNo = Err.Number
- On Error GoTo 0
- Select Case intErrNo
- Case 3011, 3024, 3044, 3055, 7874
- varLinkAry(intParam) = "DATABASE=" & strOldLink
- .Connect = Join(varLinkAry, ";")
- strMsg = "Database file (%F) not found.%L" & _
- "Unable to ReLink [%T]."
- strMsg = Replace(strMsg, "%F", strNewLink)
- strMsg = Replace(strMsg, "%L", vbCrLf)
- strMsg = Replace(strMsg, "%T", .Name)
- Call MsgBox(Prompt:=strMsg, _
- Buttons:=vbExclamation Or vbOKOnly, _
- Title:="ReLink")
- If intErrNo = 3024 _
- Or intErrNo = 3044 _
- Or intErrNo = 3055 Then Exit For
- Case Else
- strMsg = "[%T] relinked to ""%F"""
- strMsg = Replace(strMsg, "%T", .Name)
- strMsg = Replace(strMsg, "%F", strNewLink)
- Debug.Print strMsg
- End Select
- End If
- End If
- End If
- End With
- Next tdf
- End Sub
Mario