質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.60%

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

受付中

回答 2

投稿

  • 評価
  • クリップ 1
  • VIEW 983

veinte

score 4

前提・実現したいこと

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/ツールのバージョンなど)

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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • hatena19

    2020/04/17 23:01 編集

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

    キャンセル

  • hatena19

    2020/04/17 23: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 13:19

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

    キャンセル

  • veinte

    2020/04/18 13:20

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

    キャンセル

回答 2

0

DoCmd.TransferSpreadsheet はシート名を指定してのエクスポートはできないですね。
エクスポート先にクエリと同じ名前で定義されたセル範囲があればそこにエクスポートされるということだそうです。

Access2019から「DoCmd.TransferSpreadsheet メソッド - マイクロソフト コミュニティ

-2147217904:1つ以上の必要なパラメーターの値が設定されていません。

エクスポートするクエリがパラメータクエリではないですか。だとしたら、レコードセットを Open する前に、Paremetersプロパティの設定が必要です。詳細は下記をご参考に。

Access VBA:ADOでパラメータクエリーを実行してレコードセットを取得するサンプルプログラム

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

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

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

    'レコードセット
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    With rst
        .CursorLocation = adUseServer
        .CursorType = adOpenKeyset
        .LockType = adLockReadOnly
    End With
    rst.Open "select * from 名簿", cnn, , , adCmdText

    'Excelに出力
    Dim appExcel As Excel.Application
    Dim wb As Excel.Workbook
    Set appExcel = CreateObject("Excel.Application")
    appExcel.Visible = True
    Set wb = appExcel.Workbooks.Open("C:\Data\Excel\しゅちゅりょく.xlsx")
    wb.Worksheets(1).Range("B1").CopyFromRecordset rst

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.60%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • トップ
  • VBAに関する質問
  • AccessのVBAで、クエリの結果を既にあるエクセルファイルの指定したシート(入力用)に出力したい