Accessのテーブル・クエリの表をExcelにコピーする

2023年1月18日

Accessを利用している場合、テーブルやクエリの内容をExcel上にコピーして利用するケースがあるかと思います。表全体をコピーするのであればコピー貼り付け機能を使えば難なくExcel上にデータをもって来れますが、特定の箇所を定期的にExcel上にコピーする場合はボタンをワンクリックするだけでコピーできる機能があると重宝します。
今回ご紹介するサンプルアプリを使うとボタンをワンクリックするだけでAccessの特定の箇所をExcel上に持ってくることができます。手作業でコピーしてデータ加工するのに比べ格段に速く処理できますのでルーチンワーク等でご活用ください。

サンプルアプリ利用方法

「Accessからデータ取り込み」ボタンをクリックするとクエリで作成した「首都圏勤務社員一覧」から社員Noと氏名、勤務地、通勤手当の欄を抜き出してエクセルにデータをコピーします。

処理内容

処理の大まかな流れは下記の通りです。
大量のデータ処理には向いていませんので、データ数が多い場合はAccessのクエリでデータを絞った上でコピーすることをお勧めします。

 各変数の定義
    ↓
 既存データの最終行と最終列を取得
    ↓
 既存データの削除
    ↓
 Accessファイルが存在するパスを指定
    ↓
 ADOコネクション・レコードセットオブジェクトを作成
    ↓
 Accessファイルを指定
    ↓
 Accessのコピー元の表を指定
    ↓
 AccessからExcelへデータコピー
    ↓
 レコードセット・コネクションのクローズ
    ↓
 上記オブジェクトを破棄

コード   アプリの作成手順はこちら

実行した際に連携エラーが発生した場合は下記リンク先の対処方法で回避できます。
 https://scodebank.com/?p=696

Option Explicit

Sub Sample()

  Dim i As Long    'カウント変数の定義
  Dim DBpath As String 'ファイル名変数の定義
  Dim adoCn As Object 'ADOコネクションオブジェクト変数の定義
  Dim adoRs As Object 'ADOレコードセットオブジェクト変数の定義
  
  'データ最終行列を入れる変数を定義
  Dim myLastr As Long
  Dim myLastc As Long
    
  'データ最終行を取得
  myLastr = Trim(Str(Cells(Rows.Count, 2).End(xlUp).Row))

  'データ最終列を取得
  myLastc = Trim(Str(Cells(6, Columns.Count).End(xlToLeft).Column))
    
  '既存のデータを削除
  Range(Cells(6, 2), Cells(myLastr, myLastc)).ClearContents
  
  '当Excelファイルがあるカレントパスを取得
  Dim xPath  As String
  With ActiveWorkbook
    xPath = .Path & "\"
  End With
  
  '接続するファイルのフルパスを設定
  DBpath = xPath & "\サンプルDatabase.accdb"
  
  'ADOコネクションオブジェクトを作成
  Set adoCn = CreateObject("ADODB.Connection")
  
  'ADOレコードセットオブジェクトを作成
  Set adoRs = CreateObject("ADODB.Recordset")
    
  'Accessファイルを指定
  adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
             "Data Source=" & DBpath & ";"
  
 'Accessの表を指定
  adoRs.Open "首都圏勤務社員一覧", adoCn
  
  'AccessからExcelへデータコピー
  i = 6  'スタート行指定

  Do Until adoRs.EOF 'レコードセットが終了するまで処理を繰り返す
  
    Cells(i, 2) = adoRs.Fields("社員No").Value
    Cells(i, 3) = adoRs.Fields("氏名").Value
    Cells(i, 4) = adoRs.Fields("勤務地").Value
    Cells(i, 5) = adoRs.Fields("通勤手当").Value
    
    i = i + 1      '行をカウントアップ
    adoRs.MoveNext '次のレコードに移動
    
  Loop
 
  adoRs.Close 'レコードセットのクローズ
  adoCn.Close 'コネクションのクローズ
  
  'オブジェクトを破棄
  Set adoRs = Nothing
  Set adoCn = Nothing

End Sub