CSV形式でエクスポートし、その後ZIP形式で圧縮

Sub ExportAndCompressData()
    Dim rs As Recordset
    Dim db As Database
    Dim strSQL As String
    Dim exportPath As String
    Dim zipPath As String
    Dim zipFileName As String
    Dim shellApp As Object
    
    ' エクスポートするデータのクエリを指定
    strSQL = "SELECT * FROM YourTableName"
    
    ' エクスポート先のフォルダーとファイル名を指定
    exportPath = "C:\ExportFolder\" ' エクスポート先のフォルダー
    zipFileName = "ExportedData.zip" ' ZIPファイルの名前
    
    ' エクスポート先のフォルダーが存在しない場合、作成する
    If Dir(exportPath, vbDirectory) = "" Then
        MkDir exportPath
    End If
    
    ' データをCSV形式でエクスポート
    DoCmd.TransferText acExportDelim, , "YourTableName", exportPath & "ExportedData.csv"
    
    ' ZIPファイルのパスを設定
    zipPath = exportPath & zipFileName
    
    ' ZIPファイルを作成
    Set shellApp = CreateObject("Shell.Application")
    shellApp.Namespace(zipPath).CopyHere shellApp.Namespace(exportPath & "ExportedData.csv").items
    
    ' エクスポートされたCSVファイルを削除
    Kill exportPath & "ExportedData.csv"
    
    ' オブジェクトを解放
    Set shellApp = Nothing
    
    MsgBox "Data exported and compressed successfully.", vbInformation
End Sub