Sub ExportToExcelAndCompress()
Dim xlApp As Object
Dim xlBook As Object
Dim rs As Recordset
Dim strSQL As String
Dim filePath As String
' エクスポートするデータのクエリを指定
strSQL = "SELECT * FROM YourTableName"
' データをレコードセットとして取得
Set rs = CurrentDb.OpenRecordset(strSQL)
' 新しいExcelアプリケーションを開始
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False ' Excelを表示しないように設定
' 新しいブックを作成
Set xlBook = xlApp.Workbooks.Add
' レコードセットからデータをエクセルにコピー
rs.MoveFirst
For i = 0 To rs.Fields.Count - 1
xlBook.Sheets(1).Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
Dim rowIndex As Integer
rowIndex = 2 ' データの書き込みを開始する行
Do Until rs.EOF
For i = 0 To rs.Fields.Count - 1
xlBook.Sheets(1).Cells(rowIndex, i + 1).Value = rs.Fields(i).Value
Next i
rs.MoveNext
rowIndex = rowIndex + 1
Loop
' Excelファイルを保存
filePath = "C:\YourFolderPath\YourFileName.xlsx" ' 保存先のファイルパスを指定
xlBook.SaveAs filePath
' ブックを閉じる
xlBook.Close
' Excelアプリケーションを終了
xlApp.Quit
' オブジェクトを解放
Set xlBook = Nothing
Set xlApp = Nothing
rs.Close
Set rs = Nothing
' Excelファイルを圧縮する
Call Shell("powershell.exe -nologo -noprofile -command ""& { Add-Type -Assembly 'System.IO.Compression.FileSystem'; [System.IO.Compression.ZipFile]::CreateFromDirectory('C:\YourFolderPath\', 'C:\YourFolderPath\YourFileName.zip'); }""", vbHide)
' 元のExcelファイルを削除する（オプション）
Kill filePath
End Sub
Excel形式でファイルを保存/圧縮ファイル作成
