ちょっと、苦労した。
Private Sub cmdDMデータ作成_Click() On Error GoTo Err_cmdDMデータ作成_Click Dim rstf As String Dim F As String Dim Qdf As QueryDef F = Me.Filter 'フォームフィルタの内容 rstf = "SELECT * FROM 顧客ID毎カウント WHERE " & F & ";" 'フォームのレコードセット+フィルタ Set Qdf = CurrentDb.CreateQueryDef("QryTemp", rstf) '    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QryTemp", CurrentProject.Path & "/DM.xls", True, strSheetName 'Excelで保存 '   DoCmd.TransferText acExportDelim, , "QryTemp", CurrentProject.Path & "/DM.csv", True 'CSVで保存 DoCmd.OutputTo acOutputQuery, "QryTemp" 'ファイル形式を選択して保存 MsgBox "Excelファイルへの出力が終了しました" DoCmd.DeleteObject acQuery, "QryTemp" Set Qdf = Nothing Exit_cmdDMデータ作成_Click: Exit Sub Err_cmdDMデータ作成_Click: MsgBox err.Description If err.Number = 2302 Then MsgBox "Excelファイルを保存できません。ファイルが開かれていないか確認してください。" DoCmd.DeleteObject acQuery, "QryTemp" End Sub