【AccessVBA】AccessのRecordsetを Excel のListObject に変換するVBAを書いた

Recordset を Excel のListObject に変換するVBAを書いた

サンプルコード

Microsoft Access のレコードセットオブジェクトをExcelのListObject に変換する。
Entry関数を実行することで変換する。

Option Compare Database
Option Explicit

Private gBaseFolder As String

Public Sub Entry()
  '
  gBaseFolder = CurrentProject.Path & "\"
  
  Dim strFileName As String

  '--- ファイル名定義 ---
  strFileName = "出力" & Format(Now, "yyyymmddhhmmss") & ".xlsx"
  
  Call RecordsetToExcelListObj(strFileName, "テーブル名", "リストオブジェクト名")

End Sub

' Recordset を Excelファイルに出力
Public Sub RecordsetToExcelListObj(strFileName As String, TableName As String, ListObjName As String)

  
  Dim objExcel    As Excel.Application
  Dim RS          As DAO.Recordset
  Dim rs_cnt      As Integer

  '--- Excel出力 ---
  
  Set objExcel = New Excel.Application
  
  Set RS = CurrentDb.OpenRecordset(TableName)
  
  With objExcel
    .DisplayAlerts = False
    .Workbooks.Add
    .ActiveWorkbook.SaveAs FileName:=gBaseFolder & strFileName, ReadOnlyRecommended:=False
    .Workbooks.Open (gBaseFolder & strFileName)
    .ActiveWorkbook.ActiveSheet.Name = ListObjName
    
    'データ出力
    ' ヘッダを書き出し
    For rs_cnt = 1 To RS.Fields.Count
      .Cells(1, rs_cnt) = RS.Fields(rs_cnt - 1).Name
    Next
    
    .ActiveSheet.ListObjects.Add(xlSrcRange, _
    .ActiveSheet.Range(.ActiveSheet.Cells(1, 1), _
    .ActiveSheet.Cells(1, RS.Fields.Count)), , xlYes).Name = RS.Name
    
    .Cells(2, 1).CopyFromRecordset RS
    .Cells(1, 1).Select
    .ActiveWorkbook.SaveAs FileName:=gBaseFolder & strFileName, ReadOnlyRecommended:=True
    .ActiveWorkbook.Close SaveChanges:=False
    .Quit
    .DisplayAlerts = True
  
  End With
  
  RS.Close

  Set objExcel = Nothing
End Sub