マスタテーブルのレコードが増えたらカラム追加

マスタテーブル T_REHA_MENU のレコードが追加されたら
データテーブル T_REHA_REC のカラムの最後尾にカラムを追加します。

えっ！カラムの数しか比較してないじゃないかって？
そのとおりです。フィールド名の比較は(面倒になって)組み込んでません(汗；

Sub IniTable()
    Dim cnn As New ADODB.Connection
    Dim rst1 As New ADODB.Recordset
    Dim rst2 As New ADODB.Recordset
    Dim cat As ADOX.Catalog
    Dim Tbl As ADOX.Table
    Dim Idx As ADOX.Index
    Dim Col As ADOX.Column
    Dim StrSQL1 As String
    Dim StrSQL2 As String
    Dim FldName As String
    Dim RcdCnt1 As Long
    Dim RcdCnt2 As Long
    
    StrSQL1 = "SELECT t1.* " & _
            "FROM T_REHA_REC As t1;"
    
    StrSQL2 = "SELECT t1.REHAMENUID, t1.REHA, t1.CNT " & _
            "FROM T_REHA_MENU As t1 ORDER BY t1.REHAMENUID;"
    
    Set cnn = CurrentProject.Connection

    DoCmd.SetWarnings False
    Application.Echo False
    
    With rst1
        .Open StrSQL1, cnn, adOpenKeyset, adLockOptimistic
        RcdCnt1 = .RecordCount
        Debug.Print "rcdcnt1は、" & RcdCnt1
    End With
    
    cnn.Close: Set cnn = Nothing
    Set rst1 = Nothing
    
    Set cnn = CurrentProject.Connection
    
    With rst2
        .Open StrSQL2, cnn, adOpenKeyset, adLockOptimistic
        RcdCnt2 = .RecordCount
        Debug.Print "rcdcnt2は、" & RcdCnt2
        
        Set cat = New ADOX.Catalog
        cat.ActiveConnection = CurrentProject.Connection
        Set Tbl = cat.Tables![T_REHA_REC]
        Set Idx = New ADOX.Index
        Set Col = New ADOX.Column
        rst2.MoveLast
        FldName = rst2!REHA
        Debug.Print "FldName2は、" & FldName
        Tbl.Columns.Append FldName, adBoolean
        Set Col = Nothing

    End With

    Application.Echo True
    DoCmd.SetWarnings True
    
    Set cat = Nothing
    cnn.Close: Set cnn = Nothing
    Set rst2 = Nothing
End Sub