msoffice

HOME
office
msoffice
AccessでExcelを操作する

2019年7月12日 / 最終更新日時 : 2025年6月22日 officeの杜 msoffice

AccessでExcelを操作する

AccessはExcelと比較した場合、データの加工（クエリや大量のデータの処理、レポート機能）という点で、Excelよりも優れています。データ処理については速度面でも非常に有利です。一方でExcelの長所がそのままAccessの弱点になっています。

例えば縦横柔軟な表形式の文書の作成であったり、機能面での差として「クロス集計」に於いて、Excelでは出来てもAccessではできないものが存在していたりします（Accessでは列の要素は1個しか指定が出来ない）。また、クエリでは現場の要望の一部しか満たせない場合もあります（クエリ使うよりも、sumiufsのほうが手っ取り早かったり）

そんなAccessですが、Excelを遠隔操作出来たりするので、流れ作業でExcelを操作してデータの出力が非常に便利です。今回はこの遠隔操作である「オートメーション」を見ていきたいと思っています。

1 今回使用するファイル
2 事前準備
- 2.1 参照設定の追加
- 2.2 データの整備
3 ソースコード
4 関連リンク

今回使用するファイル

事前準備

参照設定の追加

今回の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ワークシートへと書き込みすることになります。

図：書き込み用に列を追加してある

ソースコード

レコードセットをそっくり出力

'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に対してフィルタの内容に応じてシートを追加し、出力していくケースが多いです。メソッド自体は同じ内容を利用します。

'分類毎にデータを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を扱うように出来たら便利だなという事で以下のようなコードもサンプルに加えてあります。

'通常の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にリンクテーブルで接続しても書き込みは出来ません（昔はできたんですけれどねぇ）

AccessでExcelを操作する

今回使用するファイル

事前準備

参照設定の追加

データの整備

ソースコード

レコードセットをそっくり出力

レコードをフィルタして出力

Excelのメソッドを使って1行ずつ書き込み

関連リンク

コメントを残すコメントをキャンセル

Boxミニマニュアル

選択行のデータをTSVテキストに変換するExcelアドイン

今回使用するファイル

事前準備

参照設定の追加

データの整備

ソースコード

レコードセットをそっくり出力

レコードをフィルタして出力

Excelのメソッドを使って1行ずつ書き込み

関連リンク

コメントを残す コメントをキャンセル

Boxミニマニュアル

選択行のデータをTSVテキストに変換するExcelアドイン

コメントを残すコメントをキャンセル