How to detect broken linked tables?

[deBassMan]

Hi all

I have an A2k f/e with an ODBC MySQL b/e.

I need a fast, simple VBA method of detecting if any table links are broken so that I can programmatically refresh them.

any ideas? - thanks in advance

 

[llkhoutx]

There's a "file system object" that can be used to check for the existence of a table. It's chronicled in the Help menu.

 

[deBassMan]

Hi thanks for your response ...

the tables (well the links to the tables) exist so I don't think I can use that object

 

[llkhoutx]

Yes, you can use that table to see what the links are. It's a read only table.

 

[neoartz237]

I coded a table linker for that, it checks the borken linked tables and reconnects it through a user interface, the code:

Public Function tablesOK() As Boolean
Dim tdf As TableDef
Dim db As Database
Dim quer As String
Dim rst As Recordset

Set db = CurrentDb

For Each tdf In db.TableDefs
If tdf.Connect <> "" Then
On Error GoTo dame
quer = "SELECT * FROM " & tdf.Name
Set rst = CurrentDb.OpenRecordset(quer)
GoTo ok
dame:
tablesOK = False
Exit Function
ok:
tablesOK = True
End If
Next tdf
End Function


If its True then all table links are in tact, hence if false, there's something broken.

I relinked it through:

Public Function reLinkMan() As Boolean
Dim tdf As TableDef
Dim db As Database
Dim item As Variant
Dim tblName As String
Dim selected, i As Integer
Dim linkThis As String
Dim rst As Recordset

On Error GoTo doon


linkThis = Me.txtRelinkPath.Value '<< --- FileOpenDialog result

If pwdFileExist Then
If getPassword <> "" Then
'******************'
'* HENSHUU TABLES *'
'******************'

selected = Me.lstLink.ItemsSelected.Count
If selected = 0 Then
MsgBox "ﾚﾘﾝｸをしたいテーブルを選んで下さい"
Exit Function
End If
Set db = CurrentDb
For Each item In Me.lstLink.ItemsSelected '<<-- list box holding all tables, select the one's you wish to reconnect
tblName = Trim(Me.lstLink.ItemData(item))
Set tdf = db.TableDefs(tblName)
tdf.Connect = "MS Access;PWD=" & getPassword & ";DATABASE=" & linkThis
DoCmd.RunSQL ("UPDATE tblDatalinker set path = '" & linkThis & "' where tablename = '" & tdf.Name & "'")
tdf.RefreshLink
Me.lstLink.selected(item) = False
Next item

'*****************'
'* BACKUP TABLES *'
'*****************'
selected = Me.lstLink2.ItemsSelected.Count
linkThis = Me.txtRelinkPath2.Value
Set db = CurrentDb
For Each item In Me.lstLink2.ItemsSelected
tblName = Trim(Me.lstLink2.ItemData(item))
Set tdf = db.TableDefs(tblName)
tdf.Connect = "MS Access;PWD=" & getPassword & ";DATABASE=" & linkThis
DoCmd.RunSQL ("UPDATE tblBackupLinker set path = '" & linkThis & "' where tablename = '" & tdf.Name & "'")
tdf.RefreshLink
Me.lstLink2.selected(item) = False
Next item

Else
MsgBox "パスワードファイルが空です。", vbCritical, "開始処理"
Exit Function
End If
Else
MsgBox "パスワードファイルが見つかりません。", vbCritical, "開始処理"
Exit Function
End If
reLinkMan = True
doon:
Set rst = Nothing
End Function


Hope it helps, sorry, messages are in Japanese

 

[deBassMan]

thanks neoartz

I came up with something similar.

I tried running a query and checking the error code - if an error is reported then I assume the link is broken.

I then relink all linked tabvles.

thanks for your input