【Access VBA】リンクテーブル連続更新・データ追加

Accessの複数のファイルのテーブルデータ（以下「追加元データ」）をひとつのAccessファイルのテーブル（以下「追加先テーブル」）に統合したい場合、通常であれば、データを追加していきたいAccessに「追加先テーブル」と「追加元データ」にリンクされたテーブルで追加クエリを作成し、リンクテーブルマネージャーで「追加元データ」のリンクテーブルを都度変更しながら、追加クエリを実行していく必要がありますが、下記のコードを使えば、自動で連続して、リンクテーブルの更新・データ追加を行うことができます。

追加元のAccessファイルが大量にある場合は、短時間でデータを統合できますので非常に便利です。

【下記コードの前提条件】
１．「追加元データ」が格納されている複数のAccessのテーブルは、すべて同じテーブル構造で
　　あること
２．データを統合する「追加クエリ」を事前に作成しておくこと
　　（「追加クエリ」を事前に作成せずに、コード内でクエリを実行する場合は、SQLを発行して
　　実行します）

【下記コードの実行方法】
統合したい(統合後の)テーブルのあるAccessの標準モジュールに下記のコードを貼り付け、実行します。

Option Compare Database
Option Explicit

Sub リンクテーブル連続更新_データ追加()

    Dim db As DAO.Database
    Dim tb As DAO.TableDef
    
    Dim lnkTbName As String '統合したい(統合後の)テーブルのあるAccess内のリンクテーブル名
    Dim lnkAccFName As String '更新していくリンク元Accessファイル名
    
    Dim accFPath As String　'更新していくリンク元Accessフルパス    
    Dim folderName As String '更新していくリンク元Accessファイルが格納されたフォルダのパス
    Dim fileName As String　'ループで取り出されるリンク元Accessファイル名
    
    MsgBox "「リンク変更⇒データ追加」を連続して行います。"
    
    DoCmd.SetWarnings False
    
    folderName = "C:\Users\" '更新していくリンク元Accessファイルが格納されたフォルダのパス
    
    accFPath = folderName & "*.accdb" '更新していくリンク元Accessフルパス
    
    fileName = Dir(accFPath) 'ループで取り出されるリンク元Accessファイル名
    
    If fileName = "" Then
        MsgBox "フアイルが見つかりません。"
        Exit Sub
    End If
    
    Set db = CurrentDb
    
    lnkTbName = "T_追加元テーブル" '統合したい(統合後の)テーブルのあるAccess内のリンクテーブル名
    
    Set tb = db.TableDefs(lnkTbName)
    
    Do While fileName <> ""
    
        lnkAccFName = folderName & fileName '更新していくリンク元Accessファイル名
        
        '統合したい(統合後の)テーブルのあるAccess内のリンクテーブル(lnkTbName)のリンク元を
　　　　'更新していくリンク元Accessファイル (lnkAccFName)内のテーブルに変更(更新)
        tb.Connect = ";DATABASE=" & lnkAccFName & ";TABLE=" & lnkTbName
        tb.RefreshLink 'リンク情報の更新
        
        Debug.Print fileName
        
        'リンク更新後に事前に作成した追加クエリを実行・・・①
        Dim qName As String
        qName = "Q_データ追加"
        DoCmd.OpenQuery qName
        
        fileName = Dir()　'次のリンク元Accessファイル名
    
    Loop

    DoCmd.SetWarnings True
    
    MsgBox "「リンク変更⇒データ追加」の連続処理が終了しました"

End Sub

なお、コードの①で、SQLを実行する場合のコードは以下の通りです。
（「追加元」および「追加先」のテーブルのフィールドが「店番, CIF, ID, 顧客名」の場合）

Dim SQL As String
SQL = "INSERT INTO T_追加先テーブル ( 店番, CIF, ID, 顧客名 ) "
SQL = SQL & "SELECT T_追加元テーブル.店番, T_追加元テーブル.CIF," & _
      "T_追加元テーブル.ID, T_追加元テーブル.顧客名 "
SQL = SQL & "FROM T_追加元テーブル;"
db.Execute (SQL)