ExcelでDAOを使いデータベースソフトを作ってみよう

Option Explicit

Private Sub CommandButton1_Click()
    Dim db As Database
    Dim tbdef As TableDef
    Dim fld As Field
    Dim idx As DAO.Index
    Dim sdir As String
    
    If TextBox1.Value = "" Then
        MsgBox "作成するファイル名を入力してください。"
        Exit Sub
    End If

    sdir = ActiveWorkbook.Path
    If Right(sdir, 1) <> "\" Then
        sdir = sdir & "\"
    End If

On Error GoTo ErrExit
    ' データベースを作成します
    Set db = DBEngine.Workspaces(0).CreateDatabase(sdir & TextBox1.Value, dbLangJapanese)

    'テーブルを作成します
    Set tbdef = db.CreateTableDef("顧客マスター")

    'フィールドを作成します。
    Set fld = tbdef.CreateField("顧客ID", dbLong)
    'オートナンバー型にします。
    fld.Attributes = dbAutoIncrField
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("名前", dbText, 20)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("フリガナ", dbText, 20)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("年齢", dbLong)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("郵便番号", dbText, 10)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("住所1", dbText, 100)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("住所2", dbText, 100)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("電話番号", dbText, 20)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("FAX番号", dbText, 20)
    tbdef.Fields.Append fld
    
    Set fld = tbdef.CreateField("メール", dbText, 30)
    tbdef.Fields.Append fld
    
    '主キーの作成
    Set idx = tbdef.CreateIndex("PrimaryKey")
    Set fld = idx.CreateField("顧客ID", dbLong)
    idx.Fields.Append fld
    'Primaryプロパティをセット
    idx.Primary = True
    'インデックスを追加
    tbdef.Indexes.Append idx
    
    db.TableDefs.Append tbdef

    'データベースを閉じます
    db.Close
    '終了処理を行います
    Set fld = Nothing
    Set tbdef = Nothing
    Set db = Nothing
    
    MsgBox "正常にデータベースファイルを作成しました。"
    Exit Sub

ErrExit:
    MsgBox "データベース作成中にエラーが発生しました。" & vbCrLf & Err.Description
End Sub