DAO DAOデータベース(.mdb)作成~データ入力一連

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

Option Explicit


Sub ExcelDAO_CreateDatabase()
'********************************************
'DAOデータベース(.mdb)作成~データ入力一連
'********************************************
'参照設定Microsoft DAO Object Libraly
'フィールド名をコードで設定する場合

Dim strFilePath As String
Dim strFileName As String
Dim strTblName As String
Dim strTblPath As String

Dim objWrkSpc As DAO.Workspace
Dim objDtbs As DAO.Database
Dim objTbl As DAO.TableDef
Dim objFld As DAO.Field
Dim objIndx As DAO.Index
Dim objRcrd As DAO.Recordset

strFilePath = ThisWorkbook.Path

strFileName = "SampleFile.mdb"  'MDBファイル名
strTblName = "SampleTbl"        'MDBファイル内テーブル名

'【エラートラップ】
On Error GoTo DAO_CreateDatabase:
'【総合パスの作成】
strTblPath = strFilePath & "\" & strFileName
'【ワークスペース】
Set objWrkSpc = DBEngine.Workspaces(0)
'【データベース作成】(dbLangGeneral/dbLangJapanese)
Set objDtbs = objWrkSpc.CreateDatabase(strTblPath, dbLangJapanese)
'【テーブル作成】
Set objTbl = objDtbs.CreateTableDef(strTblName)

'---------------------------------------------------------
'【フィールド作成】(フィールド名・データ型・サイズ)
Set objFld = objTbl.CreateField("INDEX", dbLong)
'【オートナンバー設定】※注意1
objFld.Attributes = dbAutoIncrField
'【設定フィールド追加】
objTbl.Fields.Append objFld
'【主キー作成】
Set objIndx = objTbl.CreateIndex("PrimaryKey")
Set objFld = objIndx.CreateField("INDEX", dbLong)
'【設定フィールド追加】
objIndx.Fields.Append objFld
'【重複設定】(True重複なし/False重複あり)※注意2
objIndx.Primary = True
'【インデックス追加】
objTbl.Indexes.Append objIndx
'【テーブル追加】
objDtbs.TableDefs.Append objTbl

Set objIndx = Nothing
Set objFld = Nothing

'---------------------------------------------------------
Set objFld = objTbl.CreateField("NUMBER", dbLong, 6)
objTbl.Fields.Append objFld
'---------------------------------------------------------
Set objFld = objTbl.CreateField("NAME", dbText, 20)
objTbl.Fields.Append objFld
'---------------------------------------------------------
'更にフィールド追加は同上※注意3
'---------------------------------------------------------

Set objRcrd = objDtbs.OpenRecordset(Name:=strTblName)

'-------------------------------------------------------------------
'【新規レコード追加】
objRcrd.AddNew
'【データ入力】
Let objRcrd.Fields(0).Value = "3"           'フィールド[1]※注意1&2
Let objRcrd.Fields(1).Value = "10001"       'フィールド[2]
Let objRcrd.Fields(2).Value = "山田一郎"    'フィールド[3]
'【レコード保存】
objRcrd.Update
'-------------------------------------------------------------------
'更に追加
objRcrd.AddNew
Let objRcrd.Fields(0).Value = "13"          'フィールド[1]
Let objRcrd.Fields(1).Value = "10002"       'フィールド[2]
Let objRcrd.Fields(2).Value = "山田二郎"    'フィールド[3]
'Let objRcrd.Fields(3).Value = "やまだじろう"    'フィールド[4]※注意3
objRcrd.Update
'-------------------------------------------------------------------
'更に追加は同上
'-------------------------------------------------------------------
'※注意1
'オートナンバー設定なので値は不要でもOK
'※注意2
'オートナンバー重複なし設定なので値を入力した場合、重複するとエラーになる
'※注意3
'フィールド設定が無いファールドに値を入力するとエラーになります。

'【ファイル終了】
objDtbs.Close

'【開放】
Set objFld = Nothing
Set objTbl = Nothing
Set objDtbs = Nothing
'【メッセージ】
MsgBox strFileName & vbCr & vbCr & strTblPath, 0, "完了"
'【終了】
Exit Sub

'【エラートラップ】
DAO_CreateDatabase:

    If Err = 3204 Then
        If MsgBox("同フォルダに同名ファイルが既存しています。" & vbCrLf & "[はい]上書き/[いいえ]終了", vbYesNo, "") = vbYes Then
            Kill strTblPath
            Resume
        Else
            Exit Sub
        End If
    Else
        MsgBox "予期せぬエラーが発生しました。" & vbCrLf & Err.Description, vbCritical, "CreateDatabase"
    End If

End Sub
  • はてなブックマークに追加

 

2000年01月01日|[VBサンプルコード]:[DAO]