Accessのクエリの結果を、既存のエクセルに追加したい

Access2016を使用しています。
以下のことをAccessのvbaでやりたいと思っています
・クエリで抽出したレコード（複数）を、既存のエクセルに追加（コピペ）したい
・エクセルには、Ａ列に「番号」（１～9999）が既に入力されていて、Ｂ列～Ｗ列まで貼り付けたい
・クエリのフィールドは、貼り付け先のエクセルと同じにしています
　（クエリのA列は空欄なので、エクセルの番号がそのまま残る）
・例えば、エクセルＡ列の番号333までデータがある場合で、クエリの結果が３行の場合、
エクセルＡ列334,3335,3336の行に、クエリの結果をＢ～Ｗ列まで貼り付けたい
・クエリの結果を普通にコピペすると先頭行（フィールド名）までコピーされるが、フィールド名は不要
・可能なら、その後、エクセルA列の値をクエリにコピペしたい（例だと、クエリのA列の空欄３行分に、334,335,336を張り付ける）

現状では、上記を一連の流れで行うvbaがよくわからず、、
ネットで調べたものを元に
Set objExcel = CreateObject("Excel.Application")
でクエリの結果を新しいエクセルにして出力して、それを手動でコピペしています。

クエリの結果を、既存のエクセルに挿入するのは難しいのかな？と思い、
クエリの結果を新しいエクセルに出力した後に、新しいエクセルを操作することで、
新しいエクセルのデータを、既存のエクセルにコピペする方が良いのかな？と思ったのですが、
Access上で、新しいエクセルのデータをコピーする方法もよくわからず、困っています。

どなたか教えて頂けないでしょうか

No.2 ベストアンサー 回答者： KenKen_SP 回答日時： 2022/08/01 12:00

＞以下のことをAccessのvbaでやりたいと思っています

Access側の標準モジュールに貼り付けて下さい。
ご質問文の仕様になるべくあわせました。
オートメーション操作の基本的なサンプルです。

余談です。

今回はクエリ1の都合で１つ１つループで回しましたが、Range オブジェクトの CopyFromRecordset メソッドを使ってバーンとやった方が楽です。調べてみて下さい。

この回答へのお礼

やりたかったことができました！ありがとうございます！

お礼日時：2022/08/02 21:03

No.1 回答者： KenKen_SP 回答日時： 2022/08/01 11:58

Sub sampleProc()

　　'参照設定してないのでExcelの定数を定義
　　Const xlUp As Long = &HFFFFEFBE

　　'Access クエリ1 を開いてレコードセットを作成
　　Dim DB As DAO.Database: Set DB = CurrentDb
　　Dim rs As DAO.Recordset
　　Set rs = DB.OpenRecordset("クエリ1")
　　
　　'Accessレコード 0 件チェック
　　If rs.BOF And rs.EOF Then
　　　　MsgBox "該当のレコードはありません", vbInformation
　　　　Exit Sub
　　End If
　　
　　'新たに Excel を起動
　　Dim xlApp As Object 'Excel.Application
　　Set xlApp = CreateObject("Excel.Application")
　　xlApp.Visible = True
　　
　　'Excel Accessファイルと同じフォルダ内のブックを開いてオブジェクト変数へ参照
　　Dim xls_filename As String: xls_filename = CurrentProject.Path & "\test.xlsx"
　　Dim wb As Object 'Excel.Workbook
　　Set wb = xlApp.Workbooks.Open(xls_filename)
　　
　　'Excelワークシートをオブジェクト変数へ参照
　　Dim sh As Object 'Excel.Worksheet
　　Set sh = wb.Worksheets("Sheet1")
　　
　　'Excel B列で最終セルの１行下が書き込み位置
　　Dim pos_rownum As Long
　　pos_rownum = sh.Cells(sh.Rows.Count, "B").end(xlUp).Row + 1
　　
　　'Excel 今回はループでセルに書き込んで行きます
　　'Fields のインデックスは 0 ベースであることに注意
　　Do While Not rs.EOF
　　　　'クエリ1の2番目以降のフィールドをセルに書込み
　　　　Dim pos_colnum As Long: pos_colnum = 2
　　　　Dim i As Long
　　　　For i = 1 To rs.Fields.Count - 1
　　　　　　sh.Cells(pos_rownum, pos_colnum).Value = rs.Fields(i).Value
　　　　　　pos_colnum = pos_colnum + 1
　　　　Next
　　　　'クエリ1の1列目（インデックス0)をA列のセルの値で更新
　　　　rs.Edit
　　　　rs.Fields(0).Value = sh.Cells(pos_rownum, "A").Value
　　　　rs.Update
　　　　'次のレコードへ移動
　　　　pos_rownum = pos_rownum + 1
　　　　rs.MoveNext
　　Loop

　　'終了とりあえずExcelはそのまま閉じないで前面表示させる
　　xlApp.Visible = True
　　xlApp.ActiveWindow.Activate
　　Set sh = Nothing: Set wb = Nothing: Set xlApp = Nothing

End Sub