[VBA] Access DAOでテーブル，フィールド，リレーションの作成

ローカル環境でのデータベース構築の相談されたときに，Accessが選択肢として出てきた．そのときに，テーブル，フィールド，リレーションを手で一々設定するのが面倒くさいので，vbaを使用して作成したいと考えた．この記事では，それらの方法について実装したものを載せる．また，Accessのvbaを調べているときドキュメンテーションが見つけづらく，良いサイトが中々掘り出せなかったので有用だったリンクについてもまとめておこうと考えている．

この記事のターゲットとしては，データベースに関してObject Relation MappingやMVCモデルなどを知っており，コードを見れば大体動作が分かる人を対象としている．

Accessについて・有用リンク

Accessについてブログを幾つか見ていると自分だけではないことが分かるのだが，vbaに関する記事や説明がほとんど見つからない．GUIでの操作に関しては腐るほど記事があるにも関わらず，なぜこんな事態になっているか皆目検討がつかない．特にAPIのドキュメンテーションが分かりづらすぎる．

ということで，先に知っておきたかった有用リンクについて，ここに載せておく．

・Microsoft Access tips: DAO Programming Code Examples
僕が知りたかったのはこの関数だよ，この関数！　みたいな例がいっぱいある．始めたばかりの人はここを漁ると幸せになれる．

・Accessでどのくらいの規模のシステム開発ができるか　～Accessのレスポンス調査～
タイトルの通り．Accessの限界が知れる．ありがたかった．

・Microsoft Data Access Objects reference
これがDAOのAPI documentっぽい．最後の方はこれから色々探してた．

・Field.Type プロパティ (DAO)
フィールドで使える型は押さえなければ．

・Access の SQL で 3つ以上の表を join する
3つ以上の表を結合することはままあるのに，SQL作らなきゃいけない．仕方ないかぁ．

Accessでテーブル，フィールド，リレーションの作成

VBAのコードを載せて終了とする．行っていることは，テーブルを2つ作成し，”顧客No”に関してrelationを2つのテーブルの間に作成する．
更にオプションとして，”選択肢1″に対して入力規則と項目の説明を追加している．項目の説明は項目を選択したときに，左下に出てくる中の説明のことを指す．　
main と utils の二つのパートに分かれる．utilsは汎用性があるように調整した関数が複数書かれている．
まずは，main

Option Compare Database

Sub SampleTables()
    Dim db As DAO.Database
    Dim tb As DAO.TableDef
    
    Set db = CurrentDb()
    
    'Create a table
    Set tb = db.CreateTableDef("WT_sample1")
    
    'Primary key. Also you shouldadd index to this field
    Set fld = tb.CreateField("sequence_ID", dbLong)
    fld.Attributes = dbAutoIncrField
    tb.Fields.Append fld
    
    tb.Fields.Append tb.CreateField("顧客No", dbInteger)
    tb.Fields.Append tb.CreateField("氏名", dbInteger)
    tb.Fields.Append tb.CreateField("選択肢1", dbInteger)
    
    'Append table to database.
    db.TableDefs.Append tb
    
    'Add optional properties.
    Call AddPrimaryIndexToField("WT_sample1", "sequence_ID", "PrimaryKey", True)
    'This line is needed to create a relation.
    Call AddPrimaryIndexToField("WT_sample1", "顧客No", "PrimaryKey2", False)
    Call SetYesOrNoValidate("WT_sample1", "選択肢1")
    Call AddDescriptionField("WT_sample1", "選択肢1", "選択肢1の説明を挿入しています")
    
    'For illustration, create one more table.
    Set tb = db.CreateTableDef("WT_sample2")
    Set fld = tb.CreateField("sequence_ID2", dbLong)
    fld.Attributes = dbAutoIncrField
    tb.Fields.Append fld
    
    tb.Fields.Append tb.CreateField("顧客No", dbInteger)
    
    'Append a table to the database.
    db.TableDefs.Append tb
    
    'Create a relation.
    Call CreateRelationDAO("WT_sample1", "WT_sample2", _
        "顧客No", "顧客No", "relation1")
    

End Sub

Private Sub DeleteTablesAndRelations()
    Dim db As DAO.Database
    Set db = CurrentDb
    
    Call DeleteRelation("WT_sample1", "WT_sample2")
    db.TableDefs.Delete ("WT_sample1")
    db.TableDefs.Delete ("WT_sample2")

    db.Close
    
End Sub

次に，utils

Option Compare Database

Function CreateRelationDAO(T_main As String, T_sub As String, _
                            K_main As String, K_sub As String, _
                            rel_name As String)
    'Create relation between two tables.
    'T_main : primary Table
    'T_sub : foreign table
    'K_main : primary key. should be indexed
    'K_sub : foreign table key.
    'rel_name : name of relation.
    
    Dim db As DAO.Database
    Dim rel As DAO.Relation
    Dim fld As DAO.Field
    
    'Initialize
    Set db = CurrentDb()
    
    'Create a new relation.
    Set rel = db.CreateRelation(rel_name)
    
    'Define its properties.
    With rel
        'Specify the primary table.
        .Table = T_main
        'Specify the related table.
        .ForeignTable = T_sub
        'Specify attributes for cascading updates and deletes.
        .Attributes = dbRelationUpdateCascade + dbRelationDeleteCascade
        
        'Add the fields to the relation.
        'Field name in primary table.
        Set fld = .CreateField(K_main)
        'Field name in related table.
        fld.ForeignName = K_sub
        'Append the field.
        .Fields.Append fld
        
        'Repeat for other fields if a multi-field relation.
    End With
    
    'Save the newly defined relation to the Relations collection.
    db.Relations.Append rel
    
    'Clean up
    Set fld = Nothing
    Set rel = Nothing
    Set db = Nothing
    Debug.Print "Relation created."
End Function

Function AddPrimaryIndexToField(T_main As String, K_name As String, _
                    Index_name As String, primary As Boolean)

    Dim db As DAO.Database
    Dim ind As DAO.Index
    Dim tb As DAO.TableDef
    
    Set db = CurrentDb()
    Set tb = db.TableDefs(T_main)
    
    Set ind = tb.CreateIndex(Index_name)
    With ind
        .name = Index_name
        .Required = True
        .Unique = True
        .primary = primary
    End With
    Set fld = ind.CreateField(K_name)
    ind.Fields.Append fld
    tb.Indexes.Append ind

End Function

Function DeleteRelation(T_main As String, T_sub As String)
    Dim db As DAO.Database
    Set db = CurrentDb
    For Each rel In db.Relations
        If rel.Table = T_main And rel.ForeignTable = T_sub Then
            'MsgBox "削除" + rel.Name
            Debug.Print "Relation : " + rel.name + " was deleted"
            db.Relations.Delete rel.name
        End If
    Next rel
End Function

Function SetYesOrNoValidate(T_name As String, K_name As String)
    Dim db As DAO.Database
    Dim tb As DAO.TableDef
    
    Set db = CurrentDb()
    Set tb = db.TableDefs(T_name)
    
    Set fld = tb.Fields(K_name)
    fld.ValidationRule = "Like ""はい"" Or ""いいえ"" "
    
    db.Close
End Function

Function AddDescriptionField(T_name As String, K_name As String, text As String)
    'Add Description property to field.
    Dim db As DAO.Database
    Dim tb As DAO.TableDef
    
    Set db = CurrentDb()
    Set tb = db.TableDefs(T_name)
    
    Set fld = tb.Fields(K_name)
    With fld
        .Properties.Append .CreateProperty("Description", dbText, text)
    End With
    
    db.Close
End Function

このmainとutilsに書かれた基本事項を押さえれば，ある程度の大きさのAccessのデータベースを円滑に構築出来る．
詰まった点としては，
・relationを作成する際にIndexを追加しなければいけなかった点．
・vbaからは，lookup fieldを作成出来なかった点．テーブル自体にlookup fieldを作成すること自体は，ナンセンスらしい．というのも見た目は項目を入力しているようだが，実際には固有indexが振られていくため．フォームにlookup fieldを用意して実際の値を叩き込むのが定跡か？

フォームとかクエリなどは細かい調整が必要になるので，GUIでやった方が実は早かったり？　
とりあえず，手間が掛かり，かつ，手軽にコードで構築出来そうなところまで．

———-雑感(｀・ω・´)———-
うーん，大規模どころか中規模程度のデータベースにも耐えられそうにないAccessさん．ローカルで3~5人が打ち込むような作業のときに使う価値あり．それか，簡単なデータ入力や集計作業が必要なときにエクセルの代替案としてはかなり良い．

とても魅力的な点としては，クエリやフォームがぱぱっと必要最低限なものが作成出来る点．特に，一対多のリレーションがあるテーブルに対してフォームを作成したときに，連携した行だけ複数取って編集出来る画面を構築してくれるのは凄い．

Office 365を使っていれば，勝手についてくるアプリケーションとして，とても優秀．FileMakerさんは有料だけど一度触ってみたくなってくる．