実行時エラー3061

Question

お願いします。

パラメータが少なすぎます。2を指定してください。

Microsoft Access Club >SampleFile >

セル 位置指定で Excelへデータ出力する方法：SampleFile204

http://www.accessclub.jp/samplefile/samplefile\_204.htm

を利用したいとテストを繰り返しています。

テーブルのデータはうまくエクセルに渡せました。

クエリで抽出条件が無いものも渡せました。

しかし、抽出条件が[forms]![印刷]![年月日]などがあると3061エラーで２を指定・・・と出てしまいます。

抽出条件の年月は日付をyyyy/mmにしています。

よろしくお願いします。

※2003バージョンでも2010や2016でも問題は出ませんでしょうか。

Answer 1

> セル 位置指定で Excelへデータ出力する方法：SampleFile204

> http://www.accessclub.jp/samplefile/samplefile\_204.htm

QBF 技法を用いたパラメータクエリも含めて

出力できるようにするには、例えば以下のように

修正なさればよいのではないかと。

（修正例）

---

Function ToExcel(StrDataName As String)

On Error GoTo Err_ToExcel

    Dim db As DAO.Database

    Dim qdf As DAO.QueryDef

    Dim prm As DAO.Parameter

    Dim rs As DAO.Recordset

    Dim xlsApp As Object

    Dim xlsWorkbook As Object

    Dim xlsWorksheet As Object

    Dim strMsg As String

    Dim intMsg As Integer

    Dim strFilePath As String

    Dim strSheetName As String

    strMsg = "Ms Excelへデータを出力しますか ？"

    intMsg = MsgBox(strMsg, _

                    vbYesNo + vbQuestion + vbDefaultButton2, _

                    "実行確認")

    If intMsg = vbNo Then

        Exit Function

    End If

    Set db = CurrentDb

    On Error Resume Next

    Set qdf = db.QueryDefs(StrDataName)

    If Err.Number = 0 Then

        On Error GoTo Err_ToExcel

        For Each prm In qdf.Parameters

            prm.Value = Eval(prm.Name)

        Next

        Set rs = qdf.OpenRecordset(dbOpenSnapshot)

    Else

        Err.Clear

        On Error GoTo Err_ToExcel

        Set rs = db.OpenRecordset(StrDataName, dbOpenSnapshot)

    End If

    If rs.EOF Then

        MsgBox "出力対象となるレコードがありません。", _

               vbExclamation, _

               "データなし"

        Set rs = Nothing

        Set prm = Nothing

        Set qdf = Nothing

        Set db = Nothing

        Exit Function

    End If

    strFilePath = InputBox("Excelファイルのパスを記述して下さい", , _

                           Sub_PassGet & "sample.xls")

    If strFilePath = "" Then

        Set rs = Nothing

        Set prm = Nothing

        Set qdf = Nothing

        Set db = Nothing

        Exit Function

    End If

    If Dir(strFilePath) = "" Then

        MsgBox "出力先として指定された""" & strFilePath & """は存在しないブックです。", _

               vbExclamation, _

               "エラー"

        Set rs = Nothing

        Set prm = Nothing

        Set qdf = Nothing

        Set db = Nothing

        Exit Function

    End If

    strSheetName = InputBox("Excelファイルのシート名を記述します。", , "Sheet1")

    If strSheetName = "" Then

        Set rs = Nothing

        Set prm = Nothing

        Set qdf = Nothing

        Set db = Nothing

        Exit Function

    End If

    Set xlsApp = CreateObject("Excel.Application")

    Set xlsWorkbook = xlsApp.Workbooks.Open(strFilePath)

    Set xlsWorksheet = xlsApp.Worksheets(strSheetName)

    xlsWorksheet.Activate

    xlsWorksheet.Cells(5, 2).CopyFromRecordset rs

    xlsWorkbook.Save

    strMsg = """" & strFilePath & """のワークシート""" & strSheetName & """にデータを出力しました。"

    MsgBox strMsg, _

           vbInformation, _

           "実行完了"

Exit_ToExcel:

On Error Resume Next

    xlsWorksheet = Nothing

    xlsWorkbook.Close False

    xlsWorkbook = Nothing

    xlsApp.Quit

    xlsApp = Nothing

    Set rs = Nothing

    Set prm = Nothing

    Set qdf = Nothing

    Set db = Nothing

    Exit Function

Err_ToExcel:

    strMsg = "Error番号：" & Err.Number & vbNewLine & _

             "Error内容：" & Err.Description

    MsgBox strMsg, vbCritical, "実行時エラー"

    Resume Exit_ToExcel

End Function

---

但し通常の（ QBF 技法を用いていない）パラメータクエリについては

上記のコードでは出力できないでしょう。

Answer 2

> テーブルのデータはうまくエクセルに渡せました。

> クエリで抽出条件が無いものも渡せました。

> しかし、抽出条件が*[forms]![印刷]![年月日]*などがあると

> 3061エラーで２を指定・・・と出てしまいます。

> 抽出条件の年月は日付をyyyy/mmにしています。

パラメータクエリのレコードセットを取得される場合は、

DAO.QueryDef オブジェクトを用いてそのクエリを参照し、

その Parameters プロパティ（コレクション）を介して

それぞれのパラメータへの値渡しを行なった上、

（ DAO.Database オブジェクトではなく）

その QueryDef オブジェクトの OpenRecordset メソッドを

使用するようにして下さい。

Answer 3

おそくなりましたが、無事にできました。

全てを見直して、再度、じっくりと検証を行い、

サポートのコードを使用し思い通りに！！。

心より感謝申し上げます。

ありがとうございました。

Answer 4

参考までにどうすればよいのでしょうか。

いつも、コピペしてるだけなので、書き方や意味がわかりません。

どうぞよろしくお願いします。

Function ToExcel(StrDataName As String) 'データ元を引数としています。

On Error GoTo エラー

    Dim db As DAO.Database

    Dim rs As DAO.Recordset

    Dim objEXE As Object

    Dim strmsg As String

    Dim intmsg As Integer

    Dim varinput1, varinput2, varinput3 As Variant