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

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][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
関連リンク
DAO_Table_Name.html DAO DAOを使いMDBファイルのテーブル名を取得(ExcelVBA)
DAO_CreateDatabase.html DAO DAOデータベース(.mdb)作成〜データ入力一連
DAO_MDB_OpenRead.html DAO DAOを使いMDBファイルを開けてデータを読む(ExcelVBA)
RefRemoveAcquisition.html 参照設定 参照設定されているライブラリを検索取得
RefRemoveChoice.html 参照設定 追加されている参照設定を解除(一覧より指定)
RefRemove.html 参照設定 追加されている参照設定を解除(Library指定)
DAOAddFromFile.html 参照設定 DAO参照設定エクセル(ExcelVBA)





Production Japan Import Application. Since 1998