QueryDefのparameters記述を省略したい

実現したいこと

同じparametersの記述が複数回あるので、1つにまとめて読みやすくしたい

前提

クリック時イベントで、いくつかのパラメータクエリをExcelにエクスポートし、表に整形するフォームを作成しています。

発生している問題・エラーメッセージ

エクスポートする5つのクエリのうち4つがパラメータクエリで、4つとも抽出条件が同じです。set qdfする度に同じ.parametersを記述しているので可読性・メンテナンス性に欠けると感じました。

該当のソースコード

Private Sub 出力_Click()

    Dim dbs As Database
    Dim qdf As QueryDef
    Dim rst As Recordset
    Dim xls As Object

    Const xlUp = -4162
    Const xlToLeft = -4159
    Const xlCellTypeBlanks = 4

    Set dbs = CurrentDb
    Set xls = CreateObject("Excel.Application")
    With xls
        .ScreenUpdating = False
        .Workbooks.Open "フルパス¥実績.xlsx"

        Set rst = dbs.OpenRecordset("Q選択クエリ")

　　　中略

        Set qdf = dbs.QueryDefs("Qパラメータクエリ1")
        With qdf
            .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
            .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
            Set rst = .OpenRecordset
        End With

　　　中略

        Set qdf = dbs.QueryDefs("Qパラメータクエリ2")
        With qdf
            .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
            .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
            Set rst = .OpenRecordset
        End With

　　　中略

        Set qdf = dbs.QueryDefs("Qパラメータクエリ3")
        With qdf
            .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
            .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
            Set rst = .OpenRecordset
        End With

　　　中略

        Set qdf = dbs.QueryDefs("Qパラメータクエリ4")
        With qdf
            .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
            .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
            Set rst = .OpenRecordset
        End With

　　　中略

        .ScreenUpdating = True
        .Visible = True
    End With
    Set xls = Nothing
    
End Sub

試したこと

Function parameters()
        With qdf
            .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
            .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
            Set rst = .OpenRecordset
        End With

Private Sub 出力_Click()

中略

        Set qdf = dbs.QueryDefs("Qパラメータクエリ1")
        Call parameters
中略
        Set qdf = dbs.QueryDefs("Qパラメータクエリ2")
        Call parameters
中略
        Set qdf = dbs.QueryDefs("Qパラメータクエリ3")
        Call parameters
中略
        Set qdf = dbs.QueryDefs("Qパラメータクエリ4")
        Call parameters
中略

End Sub

コード内で記述が重複している部分をFunctionで括れないかと思いこのように記述してみましたが、「変数が定義されていません」と構文エラーが発生しました。
そもそもFunctionで括るという考え自体が間違っているのか、記述を圧縮する方法はあるのか等ご意見を頂きたいです、よろしくお願い致します。

補足情報（FW/ツールのバージョンなど）

MicrosoftAccess2019

行動規範の内容に同意します

回答1件

ベストアンサー

参照渡し(ByRef)でQueryDefとOpenRecordsetを引数にしてSubプロシージャに渡せばいいでしょう。
(オブジェクトは基本参照渡しになるのでByRefはなくてもいいと思いますが)

vba
1Sub SetParameters(ByRef qdf As QueryDef, ByRef rst As Recordset)
2    With qdf
3        .parameters("[Forms]![F6_1出力]![集計開始年月]") = [Forms]![F6_1出力]![集計開始年月]
4        .parameters("[Forms]![F6_1出力]![集計終了年月]") = [Forms]![F6_1出力]![集計終了年月]
5        Set rst = .OpenRecordset
6    End With
7End Sub
8
9Private Sub 出力_Click()
10
11    Dim dbs As Database
12    Dim qdf As QueryDef
13    Dim rst As Recordset
14    Dim xls As Object
15
16    Const xlUp = -4162
17    Const xlToLeft = -4159
18    Const xlCellTypeBlanks = 4
19
20    Set dbs = CurrentDb
21    Set xls = CreateObject("Excel.Application")
22    With xls
23        .ScreenUpdating = False
24        .Workbooks.Open "フルパス\実績.xlsx"
25
26        Set rst = dbs.OpenRecordset("Q選択クエリ")
27
28        '中略
29
30        Set qdf = dbs.QueryDefs("Qパラメータクエリ1")
31        SetParameters qdf, rst
32
33        '中略
34
35        Set qdf = dbs.QueryDefs("Qパラメータクエリ2")
36        SetParameters qdf, rst
37
38        '中略
39
40        Set qdf = dbs.QueryDefs("Qパラメータクエリ3")
41        SetParameters qdf, rst
42
43        '中略
44
45        Set qdf = dbs.QueryDefs("Qパラメータクエリ4")
46        SetParameters qdf, rst
47
48        '中略
49
50        .ScreenUpdating = True
51        .Visible = True
52    End With
53    Set xls = Nothing
54    
55End Sub