DAO DAOデータベース(.mdb)作成～データ入力一連
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
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 'オートナンバー設定なので値は不要でもＯＫ '※注意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 |
