AccessのVBAで、クエリの結果を既にあるエクセルファイルの指定したシート（入力用）に出力したい

前提・実現したいこと

Accessでクエリの結果をすでにあるエクセルファイルの指定したシート（入力用）に出力したい

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

入力用$はすでに存在しています

該当のソースコード


Private Sub コマンド901_Click()

    Dim Path As String
    
    Path = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & "見積書_草稿.xlsx"
    
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "見積書クエリ", Path, True, "入力用!"
    MsgBox "エクスポートされました"
    
End Sub

試したこと

テーブルを任意のExcelシートへ出力する方法はソースを見つけて実現することができたのですが
そのソースコードではクエリの出力ができませんでした。
下記のコードでクエリが出力できるのが理想です。

Private Sub OutputTemplateExcel()
    Dim strsql          As String
    Dim strTemplate     As String
    Dim strFileName     As String
    Dim xlapp           As Object
    Dim myCn            As New ADODB.Connection
    Dim myRs            As New ADODB.Recordset
    
    Const csOutPutFileName = “C:\work\EXCEL出力”
    Const csOutputTemplate= “テンプレート.xlsx”

    On Error GoTo Err_Exit
    
    'ﾌｧｲﾙ名作成
    strFileName = csOutputFileName & "_" & Format(Date, "yyyymmdd") & ".xlsx"
    
    'EXCELｱﾌﾟﾘｹｰｼｮﾝを起動
    Set xlapp = CreateObject("Excel.Application")
    
    'ｾｯﾄする過程が見えないよう一旦不可視
    xlapp.Visible = False
    
    Set myCn = CurrentProject.Connection
    
    strsql = "SELECT * FROM 見積書クエリ"
    
    'ﾚｺｰﾄﾞｾｯﾄｵｰﾌﾟﾝ
    myRs.Open strsql, myCn, adOpenForwardOnly, adLockReadOnly
    
    With xlapp
        'ﾃﾝﾌﾟﾚｰﾄを開く
        strTemplate = Application.CurrentProject.Path & "\" & csOutputTemplate
        
        'ﾃﾝﾌﾟﾚｰﾄﾌｧｲﾙが存在しないときはｴﾗｰ
        If Dir(strTemplate) = "" Then
            MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー"
            .Visible = True
            .Quit
            Exit Sub
        End If
        
        'ﾃﾝﾌﾟﾚｰﾄﾌｧｲﾙｵｰﾌﾟﾝ
        .Workbooks.Open strTemplate
    
        '結果値出力処理(1行目にﾍｯﾀﾞｰを表示しているので、2行目1列目からｾｯﾄ
        .Cells(2, 1).CopyFromRecordset myRs
        
        '完了したら保存
        .ActiveWorkBook.SaveAs FileName:=strFileName
        
        MsgBox "出力しました。", vbOKOnly + vbInformation
    End With
    
    Set myRs = Nothing: Close
    Set myCn = Nothing: Close
    'Excelを終了します
    xlapp.Quit
    Exit Sub
    
Err_Exit:
    MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical, "OutputExcel()"
    Set myRs = Nothing: Close
    Set myCn = Nothing: Close
    xlapp.Quit
    
End Sub

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

何卒よろしくお願いします。

hatena19

2020/04/17 14:02 編集

前者のコード(DoCmd.TransferSpreadsheet)でも、後者のコード(CopyFromRecordset)でも、クエリの出力はできると思いますが、どのようにうまくいかないのでしょうか。

hatena19

2020/04/17 14:06

Set myRs = Nothing: Close Set myCn = Nothing: Close この部分は間違いですね。下記が正しいです。 myRs.Close: Set myRs = Nothing myCn.Close: Set myCn = Nothing Set myCn = Nothing

veinte

2020/04/18 04:19

コメントありがとうございます。前者のコードだとクエリ自体の出力はできるのですが、既存のエクセルファイル内への出力がうまくできません。また後者のコードを実行すると -2147217904：1つ以上の必要なパラメーターの値が設定されていません。となってしまいます。修正のコードに入れなおしても同じ結果でした・・・。

veinte

2020/04/18 04:20

ちなみに strsql = "SELECT * FROM 見積書クエリ" この部分をクエリではなくテーブル名に直すと問題なく出力されるので、クエリで動かないのはなぜだと悩んでいます・・・。

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

回答2件

見たソースコードには、何点かＮＧ箇所があります。
一つは、レコードセットオブジェクトのインスタンスを作っていないこと。
ようするに、Set 文がありません。
レコードセットオブジェクトが無いのに、どうやって、データを扱うのでしょうか？

また、Openメソッドには、Optionパラメータがあります。
Optionパラメータには、adCmdText → SQL文、adCmdTable → テーブル等が存在します。それを指定しましょう。
例題の場合は、SQL文をレコードセットにしているので、adCmdTextのパラメータ値を使用します。

Access
1    'レコードセット
2    Dim cnn As ADODB.Connection
3    Dim rst As ADODB.Recordset
4    Set cnn = CurrentProject.Connection
5    Set rst = New ADODB.Recordset
6    With rst
7        .CursorLocation = adUseServer
8        .CursorType = adOpenKeyset
9        .LockType = adLockReadOnly
10    End With
11    rst.Open "select * from 名簿", cnn, , , adCmdText
12    
13    'Ｅｘｃｅｌに出力
14    Dim appExcel As Excel.Application
15    Dim wb As Excel.Workbook
16    Set appExcel = CreateObject("Excel.Application")
17    appExcel.Visible = True
18    Set wb = appExcel.Workbooks.Open("C:\Data\Excel\しゅちゅりょく.xlsx")
19    wb.Worksheets(1).Range("B1").CopyFromRecordset rst
20