Office関連

MDB(Accessデータベース)ファイルを作成してデータを格納するExcelマクロ

2012/2/22追記:
下記で作成したMDBファイルを利用したWordマクロを考えてみました。

データの格納先としてCSVファイルがよく使われますが、数万件単位のデータになるとCSVファイルでは少々扱いづらくなってきます。
そこで今回はMDBファイルにデータを格納するマクロを考えてみたいと思います。

テストには「WEB便利ツール」で公開されている辞書データを使用しました(A、B列ともに文字列として読み込み)。


Option Explicit

Public Sub CreateMDB()
'MDBファイル作成
  Dim DBFilePath As String
  Dim con As String
  Dim tbl As Object
  Dim cn As Object
  Dim i As Long
  
  Const TableName As String = "tblDic" 'テーブル名
  Const FieldName1 As String = "word" 'フィールド名1
  Const FieldName2 As String = "meaning" 'フィールド名2
  
  DBFilePath = ThisWorkbook.Path & Application.PathSeparator & "MyDB.mdb"
  If Len(Dir(DBFilePath)) > 0 Then Kill DBFilePath '事前に削除
  con = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFilePath
  
  'MDBファイル作成
  With CreateObject("ADOX.Catalog")
    .Create con
    Set cn = .ActiveConnection
    'テーブル追加
    Set tbl = CreateObject("ADOX.Table")
    tbl.Name = TableName
    tbl.Columns.Append FieldName1, &HCA 'テキスト型
    tbl.Columns.Append FieldName2, &HCB 'メモ型
    .Tables.Append tbl
    Set tbl = Nothing
  End With
  
  'レコード追加
  With CreateObject("ADODB.Recordset")
    .Open TableName, cn, 1, 3
    For i = 1 To ActiveSheet.Range("A1").End(xlDown).Row
      Application.StatusBar = "処理中:" & i & " / " & ActiveSheet.Range("A1").End(xlDown).Row 'ステータスバーに状況表示
      .AddNew
      .Fields(FieldName1).Value = ActiveSheet.Cells(i, 1).Value
      .Fields(FieldName2).Value = ActiveSheet.Cells(i, 2).Value
      .Update
      DoEvents
    Next
    .Close
  End With
  cn.Close
  Set cn = Nothing
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
  Application.StatusBar = False
End Sub

処理終了後、作成されたMDBファイルをAccessで開いてみると、無事にデータが格納されていました。

どうやら上手く処理できたようです。
(ADOやADOXは久しく扱っていないので、色々と思い出しながらの作業でした…(^^; )

関連記事

  1. Office アドイン

    [Office用アプリ]「ActiveViewChanged」イベントと「getActiveView…

    v1.1で追加された、ビューが変更された時に発生するイベント「Acti…

  2. Office関連

    「カレンダーから日付入力」をUserFormに移植してみました。

    前回の記事では、Office 用アプリ「カレンダーから日付入力」と同様…

  3. アイコン一覧

    Office 365アイコン(imageMso)一覧(D)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  4. Windows 10

    Microsoft Edgeを操作するVBAマクロ(WebDriver編)

    Microsoft Edge Dev Blogに「Bringing a…

コメント

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP