2012/2/22追記:
下記で作成したMDBファイルを利用したWordマクロを考えてみました。
データの格納先としてCSVファイルがよく使われますが、数万件単位のデータになるとCSVファイルでは少々扱いづらくなってきます。
そこで今回はMDBファイルにデータを格納するマクロを考えてみたいと思います。
テストには「WEB便利ツール」で公開されている辞書データを使用しました(A、B列ともに文字列として読み込み)。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | 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は久しく扱っていないので、色々と思い出しながらの作業でした…(^^; )
この記事へのコメントはありません。