AccessでExcelを操作する
AccessはExcelと比較した場合、データの加工（クエリや大量のデータの処理、レポート機能）という点で、Excelよりも優れています。データ処理については速度面でも非常に有利です。一方でExcelの長所がそのままAccessの弱点になっています。
例えば縦横柔軟な表形式の文書の作成であったり、機能面での差として「クロス集計」に於いて、Excelでは出来てもAccessではできないものが存在していたりします（Accessでは列の要素は1個しか指定が出来ない）。また、クエリでは現場の要望の一部しか満たせない場合もあります（クエリ使うよりも、sumiufsのほうが手っ取り早かったり）
そんなAccessですが、Excelを遠隔操作出来たりするので、流れ作業でExcelを操作してデータの出力が非常に便利です。今回はこの遠隔操作である「オートメーション」を見ていきたいと思っています。
リンク
目次
今回使用するファイル
事前準備
参照設定の追加
今回のAccessアプリは普段使っているDAOではなく、ADOを用いてレコードデータを取得しています。そこで以下の手順で参照設定を追加しておかないとコードが動きません。また、今回もリボンを使ってるので、その為の参照設定も追加しておきます。
- データベースツールタブの「Visual Basic」を開きます。
- メニューより「ツール」⇒「参照設定」を開きます。
- 「Microsoft ActiveX Data Objects 2.8 Library」を見つけ出しチェックを入れます。
- リボンの為に「Microsoft Office 15.0 Object Library」を見つけ出しチェックを入れます。
この設定を加える事で、ADOでCopyFromRecordsetを利用する事が出来るようになります。
図：ADOもいろいろバージョンがあるけれど
データの整備
今回のサンプルデータは、国土地理院の国土数値情報で配布されているGIS用のデータを加工して、Accessに取り込んであります。DBFファイルが本体で、LibreOfficeにて取り込み、CSVに変換した後、Accessへとインポート済みです。さらに書き込み用に「緯度と経度」の列をカンマで連結させた列を追加したクエリを用意してあります。
実際の書き込みでは、このクエリを出力先のExcelワークシートへと書き込みすることになります。
図：書き込み用に列を追加してある
ソースコード
レコードセットをそっくり出力
|
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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 |
'Excelを遠隔操作してリストを生成する(Excelオートメーション使用) Public Sub minpriceexp() Dim AppObj As Object 'Excel.Applicationオブジェクトの宣言 Dim WBObj As Object 'Excel.Workbookオブジェクトの宣言 Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言 Dim filepath As String Dim strFolderName As String Dim strFileName As Variant Dim dummyfile As String 'エクスポート用のクエリを開く Dim con As New ADODB.Connection Dim rec As New ADODB.Recordset '現在開いているデータベースと接続する Set con = CurrentProject.Connection 'デスクトップフォルダを取得 Dim dPath As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") dPath = WSH.SpecialFolders("Desktop") & "\" '仮のファイル名を生成する dummyfile = dPath & "道の駅一覧" '名前をつけて保存ダイアログを表示 strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xlsx)|*.xlsx", "", dummyfile & ".xlsx") '選択結果を評価 If strFileName = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルされました。" Exit Sub End If 'テンプレファイルを指定する filepath = CurrentProject.Path & "\roadstation.xlsx" 'ファイルを複製する（ダイアログ使用） FileCopy filepath, strFileName 'ファイルを開く Set AppObj = CreateObject("Excel.Application") '実行時バインディング Set WBObj = AppObj.Workbooks.Open(strFileName) 'ワークブックを開く Set WsObj = WBObj.Worksheets("Sheet1") '書き込み先シート名の指定 'Excelの設定を変更する AppObj.ScreenUpdating = False AppObj.Visible = False 'Excelアプリケーションを表示する AppObj.Calculation = xlManual '再計算を停止する '砂時計のマウスポインタ DoCmd.Hourglass True 'ワークシートへの処理 'Excelにエクスポートしたいテーブルのデータを取得 rec.Open "出力用クエリ", con WsObj.Range("a2").CopyFromRecordset rec rec.Close '再計算に戻す AppObj.ScreenUpdating = True AppObj.Calculation = xlAutomatic AppObj.Visible = True DoCmd.Hourglass False 'Excelを保存して閉じる WBObj.Save 'ワークブックを保存する WBObj.Close 'ワークブックを閉じる AppObj.Quit '終了処理 Set AppObj = Nothing Set WBObj = Nothing Set WsObj = Nothing 'メッセージ表示 MsgBox "テーブルデータの書き出しが完了しました。" End Sub ’ファイル名を取得する為の関数 Function GetFileName(OpenOrSaveFlg As Boolean, strFilter As String, _ strTitle As String, strDefaultPath As String) As String Dim returnValue As Integer Dim strFilePath As String strFilePath = strDefaultPath If strFilter = "" Then strFilter = "全てのファイル (*.*)|*.*" End If WizHook.Key = 51488399 'WIZHOOK有効 returnValue = WizHook.GetFileName( _ 0, "", strTitle, "", strFilePath, "", _ strFilter, _ 0, 0, 0, OpenOrSaveFlg _ ) WizHook.Key = 0 ' WizHook 無効 If returnValue = 0 Then GetFileName = strFilePath Else GetFileName = 0 End If End Function |
- 起動すると、名前を付けて保存ダイアログが開き、ファイル名入力を促されます。
- テンプレートになるroadstation.xlsxがコピーされ開き、そこへCopyFromRecordsetにて一発書き込みをしています。
- 書き込み元は「出力用クエリ」で、緯度経度を連結させた列を含めて必要なデータを書き込みしています。
- 書き込み中は、再計算やアプリケーションの表示はさせない用に制御しているので、高速で書き込みが終わります。
- デスクトップフォルダのパスの取得や、Excel本体については、実行時バインディングにて処理をしているので、「参照設定」への追加は不要です。
- DAOであっても、CopyFromRecordsetは利用が可能です。
- また、CopyFromRecordsetの場合書き出し可能なデータ量に制限があるようです。。
レコードをフィルタして出力
前項の内容はクエリやテーブルの中身をそのまま出力する方法です。しかし、時には同じクエリやテーブルに対して動的にフィルタ（WHERE条件）を付けて、連続で出力したい場合があります。大抵このケースでは、テンプレートになるExcelに対してフィルタの内容に応じてシートを追加し、出力していくケースが多いです。メソッド自体は同じ内容を利用します。
|
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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
'分類毎にデータをExcelシートに出力する Public Function exportSheetData() ・・・・・前略・・・・・ 'ファイルを開く Set AppObj = CreateObject("Excel.Application") '実行時バインディング Set WBObj = AppObj.Workbooks.Open(strFileName) 'ワークブックを開く 'Excelの設定を変更する AppObj.ScreenUpdating = False AppObj.Visible = False 'Excelアプリケーションを表示する AppObj.Calculation = xlManual '再計算を停止する AppObj.DisplayAlerts = False '砂時計のマウスポインタ DoCmd.Hourglass True 'データベース接続用 Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb() Set rs = db.OpenRecordset("分類一覧", dbOpenDynaset) '出力対象を基準にループでレコードセット書き出し Dim bunrui As String Do Until rs.EOF '分類名を取得する bunrui = rs("分類") 'SQLにてレコードセットをフィルタしてセット Set rec = con.Execute("SELECT * FROM 出力用 WHERE 分類='" & bunrui & "'") 'templateシートをコピーして名前をつける With WBObj .Worksheets("template").Copy After:=.Worksheets(.Worksheets.Count) .ActiveSheet.Name = bunrui 'レコードセットを書き出し .Worksheets(bunrui).Range("A2").CopyFromRecordset rec End With 'クローズ rec.Close '次の基準 rs.MoveNext Loop 'templateシートを削除する WBObj.Worksheets("template").Delete '再計算に戻す AppObj.ScreenUpdating = True AppObj.Calculation = xlAutomatic AppObj.Visible = True DoCmd.Hourglass False AppObj.DisplayAlerts = True 'Excelを保存して閉じる WBObj.Save 'ワークブックを保存する WBObj.Close 'ワークブックを閉じる AppObj.Quit '終了処理 Set AppObj = Nothing Set WBObj = Nothing Set WsObj = Nothing db.Close Set db = Nothing Set rs = Nothing 'メッセージ表示 MsgBox "分類別シートデータの書き出しが完了しました。" end function |
- template.xlsxがstrFileNameに入っています
- template.xlsxはシートコピー元のtemplateという名のシートがあります。
- 分類一覧には分類項目が入っており、この数だけシートを複製しその分類を元に出力用クエリをフィルタして出力するのが目的です。
- ADOのExecuteでSQL文を実行し、出力用のクエリをWHERE条件付きでフィルタしてrecに格納しています。
- Copy After:=.Worksheets(.Worksheets.Count)にて、一番うしろにtemplateシートのコピーを作ります。
- コピーしたシートをアクティブにし、そこへrecの内容をCopyFromRecordsetで出力します。これを分類数分繰り返す
- 最後にtemplateシートを削除して保存し完了です。
Excelのメソッドを使って1行ずつ書き込み
前項ではCopyFromRecordsetにてクエリのデータを所定のシートに対して、データを一括書き込みを行いました。しかし、CopyFromRecordsetの場合、クエリやテーブルをそのまま書き込むので、データの加工はVBA上ではなくクエリ上で完成させておく必要性があります。
一方で、特定の項目の内容に応じて条件判定を行いデータをいろいろ加工したり追加したいようなケースの場合、事前にクエリやテーブルで対処しておくのは難しい事です。そこで、テーブルのデータの書き込みを通常のExcel VBAを扱うように出来たら便利だなという事で以下のようなコードもサンプルに加えてあります。
|
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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
'通常のExcel操作にてデータを書き込むためのルーチン Public Function remoteexcel() '変数の宣言 Dim AppObj As Object 'Excel.Applicationオブジェクトの宣言 Dim WBObj As Object 'Excel.Workbookオブジェクトの宣言 Dim WsObj As Object 'Excel.WorkSheetオブジェクトの宣言 'デスクトップフォルダを取得 Dim dPath As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") dPath = WSH.SpecialFolders("Desktop") & "\" '仮のファイル名を生成する dummyfile = dPath & "道の駅一覧" '名前をつけて保存ダイアログを表示 strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xlsx)|*.xlsx", "", dummyfile & ".xlsx") '選択結果を評価 If strFileName = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルされました。" Exit Function End If 'テンプレファイルを指定する filepath = CurrentProject.Path & "\roadstation.xlsx" 'ファイルを複製する（ダイアログ使用） FileCopy filepath, strFileName 'ファイルを開く Set AppObj = CreateObject("Excel.Application") '実行時バインディング Set WBObj = AppObj.Workbooks.Open(strFileName) 'ワークブックを開く Set WsObj = WBObj.Worksheets("Sheet1") '書き込み先シート名の指定 '▼ここから書き込みのためのルーチン開始 'コピーシートの最終行+1を取得 Dim lastrow As Variant lastrow = WsObj.UsedRange.Rows.Count + 1 'テーブルに接続する 'DAO関係の変数の宣言と初期化 Dim SQL As String Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb() Set rs = db.OpenRecordset("道の駅", dbOpenDynaset) 'ループでレコードセットデータをExcelへ書き込み Do Until rs.EOF 'ワークシートへ1行ずつデータを書き込み With WsObj .Range("A" & lastrow).Value = rs("緯度") '緯度 .Range("B" & lastrow).Value = rs("経度") '経度 .Range("C" & lastrow).Value = rs("都道府県名") '都道府県 .Range("D" & lastrow).Value = rs("市町村名") '市町村名 .Range("E" & lastrow).Value = rs("道の駅名") '道の駅名 .Range("F" & lastrow).Value = rs("HPアドレス1") 'ホームページ .Range("G" & lastrow).Value = rs("緯度") & "," & rs("経度") '緯度経度情報（カンマ区切り End With 'lastrowカウンタを加算 lastrow = lastrow + 1 '次のレコードへ移動 rs.MoveNext Loop 'Excelを保存して閉じる WBObj.Save 'ワークブックを保存する WBObj.Close 'ワークブックを閉じる AppObj.Quit '終了処理 Set AppObj = Nothing Set WBObj = Nothing Set WsObj = Nothing Set rs = Nothing Set db = Nothing 'メッセージ表示 MsgBox "テーブルデータの書き出しが完了しました。" End Function |
- 途中までは前項とほぼ同じルーチンになります。
- 今回のルーチンはDAOで作業をしているので、このコード自体は追加の参照設定は必要ありません。
- こちらは1行ずつワークシートに書き込む操作なので、CopyFromRecordsetより速度面では非常に遅いです（配列で処理をしたら早くなるとは思います）
- Excel VBA用のメソッドもAccess VBA上で利用が可能になるので、利便性は向上します。
- 複雑な条件判定などを事前にクエリ側で作るよりも、プロシージャ側で作り込める為、その後のメンテナンスなどを考えた場合、こちらのやり方のほうがメンテナンス性では有利だと思います。
- 単純にデータの書き込みだけでなく、グラフの作成やピボットテーブルの作成、またはそれらの操作などもAccessからExcelのワークシートへ行えるので、この手法は手法で身につけて置くとあとで助かります。
- 現在のAccessはExcelにリンクテーブルで接続しても書き込みは出来ません（昔はできたんですけれどねぇ）
