[vba/access]DBの特定テーブル内に特定のフィールド名が存在するか確認する

gistfile1.vb

"Microsoft DAO *** Object Library"が参照されていることが前提。

'テーブル名をキー、該当テーブルのフィールド名をキーに持つDictionaryを値として持つDictionary
Private mDicFieldNames As Object

Public Sub Sample()
    Const strTableName As String = "TestTable"
    Const strFieldName As String = "TestField"

    Call GetFieldNames(mDicFieldNames)

    Debug.Print HasField(strTableName, strFieldName)
End Sub

'------------------------------------------------------------------------------
'このDBのテーブル名一覧とフィールド名一覧を取得する
'------------------------------------------------------------------------------
'【引数】テーブル名とフィールド名一覧を格納するDictionary
'【戻り値】
'【備考】一覧を格納するDictionaryはテーブル名をキー、フィールド名をキーに持つ
'        Dictionaryを値に持つ
Private Sub GetFieldNames(objDictionary As Object)
    Dim objDb As Database
    Dim objTbl As TableDef
    Dim objFld As Field
    Dim dicFields As Object
    
    If objDictionary Is Nothing Then
        Set objDictionary = CreateObject("Scripting.Dictionary")
    End If
    
    Set objDb = CurrentDb
    
    For Each objTbl In objDb.TableDefs
        If Not mDicFieldNames.Exists(objTbl.Name) Then
            Set dicFields = CreateObject("Scripting.Dictionary")
            For Each objFld In objTbl.Fields
                If Not dicFields.Exists(objFld.Name) Then
                    dicFields.Add objFld.Name, ""
                End If
            Next objFld
            mDicFieldNames.Add objTbl.Name, dicFields
        End If
    Next objTbl
    
    Set objDb = Nothing
End Sub


'------------------------------------------------------------------------------
'テーブルにフィールド名が存在するかチェックする
'------------------------------------------------------------------------------
'【引数】チェックするテーブル名、検索するフィールド名
'【戻り値】フィールド名の存在の有無
'【備考】
Private Function HasField(strTableName As String, strFieldName As String) As Boolean
    Dim dicFields As Object
    Dim blnOutput As Boolean
    
    If mDicFieldNames.Exists(strTableName) Then
        Set dicFields = mDicFieldNames.Item(strTableName)
        If dicFields.Exists(strFieldName) Then
            blnOutput = True
        End If
        Set dicFields = Nothing
    End If
    
    If Not blnOutput Then
        MsgBox "テーブル「" & strTableName & "」にフィールド「" & strFieldName & "」が存在しません。"
    End If

    HasField = blnOutput
End Function