Hey guys,
I have about 60 tables that are linked via ODBC. I don't know why, but all of the tables will not connect sometimes. That isn't the problem right now, since we are only going to be using access for a few more months. Just about every time I open one of my access programs, every table will give me an ODBC call failed error. Opening up the linked table manager, selecting all, NOT prompting for a new location, and hitting ok fixes the problem.
Is there a VBA method to relink all linked tables?
Through google I have found 2 functions, and neither seems to work:
Method 1:
This one just opens the linked table manager when I run it. Nothing else happens.
Code:
Function relinkTables()Dim tdf As DAO.TableDef
For Each tdf In CurrentDb.TableDefs
' check if table is a linked table
If Len(tdf.Connect) > 0 Then
tdf.Connect = "odbc connection string to the DSN or database"
tdf.RefreshLink
End If
Next
End Function
Method 2:
Running ReLink("AFH_Platinum_Storis") just gives an error. Not sure if I'm doing something wrong?
Code:
'ReLink() Updates links of all tables that currently link to strDBName to point'to strDBName in the strLinkDest 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
Thanks in advance for any help.