複数のパラメータがあるクエリをデスクトップにCSVで出力する
パラメータクエリとは、クエリのデザイン画面で抽出条件に「[Forms]![フォーム名]![フォームのコントロール名]」が設定してあって、クエリを開くとパラメータの入力ウィンドウが表示されるものを指す。
結構このパラメータクエリで苦戦することがあったので備忘録でメモ。
今回は複数フィールドにパラメータが設定されている（「Forms]![フォーム名]![フォームのコントロール名]」の抽出条件が複数設定されている）パラメータクエリがあるとして、そのパラメータの値をフォームで指定して、デスクトップにCSVでで出力する方法。
以下のコードは前提として、とあるフォームがあって、そこにあるコントロールの値をパラメータに入れるようになっていて、ボタンをクリックするとCSVがでるという仕組み。
パラメータクエリ名は「入金チェック」となっている。
以下のコードでは、一回、フォームの値をデータ型（日付型だけ）を整えてa~gの変数に入れているけど、そのままパラメータにいれてもいいと思う。たぶん。
まず、入金チェッククエリをSQLステートメントでstSQL変数に入れて、CreateQueryDefで作成した「入金チェックCSV出力」クエリに入れる。
入金チェックCSV出力クエリは入金チェッククエリと同じ構造なので、パラメータも同じ。ということで、フォームの値をパラメータに入れる。
でもって、TransferTextでCSV出力する（TransferSpreadSheetだと「3027 データベースまたはオブジェクトは読み取り専用なので、更新できません。」のエラーが出るみたい）。
最後に、CreateQueryDefで作成した「入金チェックCSV出力」クエリを削除して完了。削除しないと次の出力ができないので注意。
Private Sub 入金状況CSV_Click()
On Error GoTo Err_入金状況CSV_Click
'入力がなければ入力を促す
If IsNull(Me.●●●) Then
MsgBox "基本画面に戻り、●●●を入力して下さい", vbExclamation
Exit Sub
End If
MsgBox "入金状況CSVををデスクトップに出力します。"
'出力先のデスクトップのパス
Dim Path As String
Path = CreateObject("WScript.Shell").Specialfolders("Desktop") & "¥" & "入金状況CSV" & Format(Date, "yyyymmdd") & ".csv"
'入金チェッククエリのパラメータに入れるフォームの値を変数に代入
Dim a As Date, b As Date, c As Long
Dim d As Long, e As Long, f As Long, g As Long, h As Long
a = Format([Forms]![入金チェック]![入金日1], "yyyy/mm/dd")
b = Format([Forms]![入金チェック]![入金日2], "yyyy/mm/dd")
c = [Forms]![入金チェック]![入金ルート1]d = [Forms]![入金チェック]![入金ルート2]f = [Forms]![入金チェック]![入金種別1]g = [Forms]![入金チェック]![入金種別2]'既存の入金チェッククエリを新しいクエリ「入金チェックCSV出力」として開き、パラメータを代入
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim stSQL As String
stSQL = "SELECT * FROM 入金チェック;" '入金チェッククエリを開く
Set db = CurrentDb()
Set qd = db.CreateQueryDef("入金チェックCSV出力", stSQL) '上でひらいた入金チェッククエリのデータを入金チェックCSV出力クエリにいれる
With qd 'パラメータに上で定義した変数の値を代入
.Parameters("[Forms]![入金チェック]![入金日1]") = a
.Parameters("[Forms]![入金チェック]![入金日2]") = b
.Parameters("[Forms]![入金チェック]![入金ルート1]") = c
.Parameters("[Forms]![入金チェック]![入金ルート2]") = d
.Parameters("[Forms]![入金チェック]![入金種別1]") = f
.Parameters("[Forms]![入金チェック]![入金種別2]") = g
End With
'入金チェックCSV出力クエリをCSVでデスクトップに出力
'TrasferSpreadSheetだと「3027 データベースまたはオブジェクトは読み取り専用なので、更新できません。」のエラーが出るのでTransferTextにする。
DoCmd.TransferText acExportDelim, , "入金チェックCSV出力", Path, True, ""
'MsgBoxで出力完了とデスクトップに作成されたか確認を促す
MsgBox "「 入金状況CSV" & Format(Date, "yyyymmdd") & ".csv 」" & "をデスクトップに出力しました。ご確認ください。"
'入金チェックCSVは残しておくと残り続けて、次の出力ができないので削除
DoCmd.DeleteObject acQuery, "入金チェックCSV出力"
qd.Close
db.Close
Set db = Nothing
Exit_入金状況CSV_Click:
Exit Sub
Err_入金状況CSV_Click:
MsgBox Err.Description
Resume Exit_入金状況CSV_Click
End Sub