Accessを業務の基幹システムにすると、Access内のデータをExcelで作成されている定型フォーマットに転記したいということが多々出てくるかと思います。
特にルーチン業務として、毎日、毎月、同じ操作をしなくてはならないとき、わざわざクエリから情報を抽出してExcel側にデータを転記する操作は非常に煩雑で時間も手間もかかる作業になります。
そこで、今回は「ある期間集計して得られた値をExcelで作成されている定型フォーマットにデータ転記する」方法を紹介したいと思います。
作成する機能の確認
今回作成する機能の前提条件を確認をします。
・品目毎に入庫数及び入庫日を登録したテーブルがある。
・サンプルデータは「2020年10月」の集計データとする。
※期間をBetween構文等で設定することでより汎用性を高めることができます。（以下の記事をご参考にしてください。）
・Excelで作成されたひな形ファイルが作られており、「C:\AccessTest」に保存されている。
実装する機能は次のとおりです。
・2020年10月で品目毎に入庫数を集計した値をExcelのひな形ファイルに転記する。
・転記する際は、Excelシートの原紙シートをコピーして転記先シートを作成する。
・Excelファイルは「YYMMDD##_入庫数集計結果.xlsx」とする。
※##は、同日に複数ファイルがあった場合にナンバリングする。
図1にひな形として作成したExcelファイルのイメージを示します。
なお、ひな形のファイルは「C:\AccessTest\ひな形.xlsx」として保存します。
サンプルデータについて
サンプルデータを格納するためのテーブルとして「T_入庫」テーブルを作成します。そして、フィールド名とデータ型を次のように設定します。
表1 サンプルテーブルのフィールド名とデータ型
| フィールド名 | データ型 |
| 品目 | 短いテキスト |
| 入庫数 | 数値型 |
| 入庫日 | 日付/時刻型 |
次に、サンプルデータを表2に示すように登録します。
表2 サンプルデータ
| 品目 | 入庫数 | 入庫日 |
| えんぴつ | 100 | 2020/10/15 |
| えんぴつ | 50 | 2020/10/18 |
| 消しゴム | 250 | 2020/10/19 |
| えんぴつ | 500 | 2020/10/22 |
| 消しゴム | 100 | 2020/10/23 |
| ノート | 140 | 2020/10/24 |
| ノート | 200 | 2020/10/31 |
参照設定について
今回VBAで実装する機能は、様々なライブラリを用いて実現していきます。以下の手順で、ライブラリの参照設定をします。
「Alt + F11」キーを押下しVBA画面を起動します。続いて、ツールタブの「参照設定」を選択します。
参照設定の画面が開くため以下のライブラリにチェックを入れて「OK」をクリックします。
・Microsoft ActiveX Data Object 6.1 Library（6.1は最新バージョンとして読み替えてください。）
・Microsoft Excel 16.0 Object Library（16.0は最新バージョンとして読み替えてください。）
・Microsoft Office 16.0 Object Library（16.0は最新バージョンとして読み替えてください。）
各種ライブラリは図2のリストの下の方に出てくるかもしれませんのでご注意ください。
これで、VBAによるコード実装の準備が整いましたので、次から実際のコードの内容を確認していきましょう。
ソースコードについて
早速、標準モジュールを追加して以下のソースコードを追加してください。なお、プロシージャの名称は「ExcelExport」としています。
Public Sub ExcelExport() 'エラー処理 On Error GoTo Err_csc '保存先の指定に向けた変数宣言 Dim varSelectedFile As Variant Dim FileSelect As String 'ファイルパス 'ファイル参照用の設定値をセットします。 －① With Application.FileDialog(msoFileDialogFolderPicker)'ダイアログタイトル名.Title = "ファイル選択"'最初に開くフォルダーをExcelのひな形ファイル保存先フォルダーとします。.InitialFileName = "C:\AccessTest\"If .Show = -1 Then 'ファイルが選択されれば -1 を返します。For Each varSelectedFile In .SelectedItemsFileSelect = varSelectedFileNextEnd IfIf FileSelect = "" Or IsNull(FileSelect) ThenMsgBox "保存先が選択されなかったため、処理を中止します。"Exit Sub End IfEnd With 'Excelファイル設定に対する変数宣言 －② Dim newFile As Double 'Excelファイル名YYYYMMDD＋連番2桁(数値) Dim strPath As String '作成するファイル名YYMMDD連番ファイル名(文字列) Dim srchXls As String '作成するフルパス Dim objExcel As Object 'Excel立ち上げ用 newFile = Val(Format(Date, "yyyymmdd") & Format(0, "00")) 'newFileをYYYYMMDD00とする Do '後判定のDo Loop文newFile = newFile + 1 'newFileの00部分に＋1strPath = Mid(newFile, 3, 6) & Right(newFile, 2) & "_入庫集計結果.xlsx" 'YYMMDD00_ファイル名+拡張子srchXls = FileSelect & "\" & strPath 'サーバー上にファイルを保存Loop Until strPath <> Dir(srchXls, vbNormal) 'Dir検索で 指定したファイル名があればループから抜ける 'エクセルオブジェクトを作成 Set objExcel = CreateObject("Excel.Application") 'エクセル画面を非表示 objExcel.Visible = False objExcel.DisplayAlerts = False 'ひな形ファイルを開く objExcel.Workbooks.Open "C:\AccessTest\ひな形.xlsx" 'ADOによるデータベースへの接続用変数宣言 －③ Dim objSelection As Object 'Excel Selection用 Dim rs As New ADODB.Recordset 'ADOのレコードセット向け変数 Dim cn As New ADODB.Connection 'ADOのDB接続用変数 Dim mySQL As String 'SQL文格納用 Dim i As Integer: i = 6 'Excelの6行目からAccessデータを転記する 'SQLで入庫数の期間集計を行う。 mySQL = "SELECT T_入庫.品目, Sum(T_入庫.入庫数) AS 入庫数の合計 " mySQL = mySQL + "FROM T_入庫 WHERE (((T_入庫.入庫日) Between #10/1/2020# And #10/31/2020#)) " mySQL = mySQL + "GROUP BY T_入庫.品目;" 'ADOでデータベースを接続し、先のSQL文を開く。 Set cn = CurrentProject.Connection rs.Open mySQL, cn, adOpenKeyset, adLockOptimistic 'テンプレートシートのコピー（原紙はそのままにする。） －④ objExcel.ActiveWorkbook.Worksheets("原紙").Copy After:=objExcel.ActiveWorkbook.Worksheets("原紙") objExcel.ActiveWorkbook.ActiveSheet.Name = "入庫数集計結果" 'シートへのデータコピー Set objSelection = objExcel.ActiveWorkbook.Worksheets("入庫数集計結果") With objSelection'2020年10月集計分であることをExcelに示す。 .Range("C3") = "2020年10月分"End With 'レコードセットが最後に来るまでデータを処理する。 －⑤ Do Until rs.EOF = True'AccessデータをExcelへ転記する。With objSelection.Range("B" & i) = rs!品目.Range("C" & i) = rs!入庫数の合計End Withi = i + 1rs.MoveNextLoop 'Excelファイルの保存処理 －⑥ objExcel.ActiveWorkbook.SaveAs srchXls objExcel.Workbooks.Close objExcel.Quit objExcel.DisplayAlerts = True Set objExcel = Nothing MsgBox "入庫数集計結果の出力を完了しました。" '作成したファイルを起動する。 If MsgBox("作成したファイルを開きますか?", vbYesNo) = vbYes Then Shell "Excel.exe " & Chr(&H22) & srchXls & Chr(&H22), vbNormalFocus 'Shellで作成したExcelを起動 End If 'エラー処理 Exit_csc: Exit Sub Err_csc: MsgBox Err.Description Resume Exit_csc End Sub
さて、作成したコードについて内容を確認していきます。
まず①について、保存先を設定するための処理として「msoFileDialogFolderPicker」を用いた処理を実装しています。これについては、以下の記事を参照してください。
次に②について、Excelファイルの名前を決めます。今回は、ファイルの作成日を「YYMMDD」として示し、かつ作成回数を「##」として示し、この後に「_入庫集計結果」をつけて「xlsx」ファイル形式保存するようにしました。
その後、ひな形として「C:\AccessTest」フォルダに保存している「ひな形.xlsx」ファイルをAccessから起動します。この際に、VisibleプロパティをFalseにしているため、画面上Excelは表示されません。
③について、集計関数として、2020年10月1日から2020年10月31日までの期間における品目毎の入庫数合計を示すSQL文を作成し、これをADOによりレコード抽出をしています。
④について、Excelへのデータコピーに対しては「原紙」シートをコピーして「入庫数集計結果」シートを別に作成し、ここに先に抽出したレコードの値を入れ込むようにしています。
⑤について、ADOで抽出したレコードを上から順に読んでいき、データをExcelファイルにコピーし、レコードがEOF（End Of File）つまり、対象レコードがなくなった段階で処理を終了します。
最後に⑥について、Excelを先に設定したファイル名で保存し、ADOによる接続も解除することで全ての処理が完了します。処理が完了したことが分かるようにメッセージボックスを表示するようにもしています。
動作確認
作成した機能の動作確認をしていきましょう。VBA画面で作成した標準モジュールの「ExcelExport」にカーソルを合わせ、「実行： F5」キーを押下します。
これにより、ファイル保存先の指定画面が表示されるため、今回はひな形ファイルが保存されている「C:\AccessTest」フォルダを選択し、「OK」をクリックします。
選択後、処理が開始され、しばらくすると処理が完了した通知が表示され、「OK」をクリックすると作成されたExcelファイルを開くかどうかの確認がされます。
ここで、「はい」を選択すると、図6に示すようにExcelファイルが開き、「T_入庫」テーブルに登録されているデータを基に、2020年10月で集計した品目毎の入庫数合計値が反映されていることが分かります。
このようにして、AccessからExcelを起動しAccess内のレコード情報をExcelへコピーすることができました。
まとめ
今回紹介した方法は、レコード操作を比較的簡単なものにしています。抽出条件を動的に設定することもできますし、SQL文を上手く組み合わせることで、より細かなデータ収集及びExcelへの転記をすることも可能です。
著者自身も、業務上のルーチン処理についてはAccessとExcelの連携を図ることで、業務全体の効率化を図っておりますので、是非今回紹介した方法をご参考にしてください。
最後に、これらVBAコードを実装するにあたって、また拡張するにあたっては専門書が様々なヒントを与えてくれると思いますので、是非1冊お手元に用意していただければと思います。
スポンサーリンク
コメント