AccessのVBAでリンクテーブル一覧を動的に取得してリンク切れしているか判定

前提

『ODBC経由のリンクテーブル』
『別Accessファイルのリンクテーブル』
の2種類のリンクテーブルを網羅。

また、Access上のテーブル名 ≠ 本来のテーブル名 となっています。

サンプルコード

参照設定に下記を追加。
Microsoft ActiveX Data Objects 2.8 Library

Option Compare Database
Option Explicit


'フォームに『コマンド0』という名前のボタンがあって、それをクリックした時というサンプル。
Private Sub コマンド0_Click()

    Dim table_def_ As TableDef
    For Each table_def_ In CurrentDb.TableDefs
    
        'ODBC経由のリンクテーブルと別Accessファイルのリンクテーブルが対象。
        If (table_def_.Attributes And dbAttachedODBC) Or (table_def_.Attributes And dbAttachedTable) Then

            Debug.Print "テーブル名 " & table_def_.Name
            Debug.Print "接続確認結果 " & CheckLinkTableConnected(table_def_.Name)
            Debug.Print "---"
            
        End If
        
    Next
    
End Sub


'テーブル名をもらって接続できるかどうかを返すヘルパー関数。
'
'下記のような確認方法だと『テーブル名が変更された』という場合を検知できないため、『テーブルに接続できるか』を確認する。
'『ODBC接続しているデータベースサーバーのIPアドレスにping通るか』
'『ODBC接続しているデータベースに接続できるか』
'『リンク先の別Accessファイルが存在しているか』
Private Function CheckLinkTableConnected(ByVal table_name As String) As Boolean

On Error GoTo Exception

    Dim rst_ As New ADODB.Recordset
    rst_.Open _
        table_name, _
        CurrentProject.Connection, _
        adOpenForwardOnly, _
        adLockReadOnly
    rst_.Close
    
    CheckLinkTableConnected = True
    
    Exit Function

Exception:
    
    Const CONNECTION_ERROR_CODE_ As Long = -2147217900
    If Err.Number = CONNECTION_ERROR_CODE_ Then
        CheckLinkTableConnected = False
    Else
        Err.Raise (Err.Number)
    End If

End Function

実行結果

リンクに問題無ければ下記。

リンク切れしていれば下記。

バージョン

Microsoft Windows [Version 10.0.22631.3880]
Microsoft Access for Microsoft 365 MSO (バージョン 2406 ビルド 16.0.17726.20078) 32 ビット