Access複数のテーブルを1つの既存シートに出力

質問

Accessの複数のテーブルを1つの既存のエクセルに出力したのですが、どのようにしたらいいのでしょうか？

試しにDO～LOOPのしたにDO～LOOPをもう1つ追加してみたところ、
エラーナンバー７５
オブジェクトが開いている場合は、操作は許可されません。
と表示されます。

Private Sub コマンド144_Click()

On Error GoTo Err_FileDialog_Click
Dim strsql1 As String
Dim strsql2 As String
Dim strsql3 As String
Dim strsql4 As String
Dim strTemplate As String
Dim strFileName As String
Dim ExpFileName As String
Dim xlapp As Object
Dim xlWB As Object
Dim myCn As New ADODB.Connection
Dim myRs As New ADODB.Recordset

'ExportData削除
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE from T_EDI_01_CVJ"
DoCmd.RunSQL "DELETE from T_EDI_02_OU"
DoCmd.RunSQL "DELETE from T_EDI_03_EDI_CUSTOMER"
DoCmd.RunSQL "DELETE from T_EDI_04_CUSTOMER"
DoCmd.SetWarnings True

'Export用クエリ実行
DoCmd.SetWarnings False
DoCmd.OpenQuery ("D_EDI_01_CVJ2")
DoCmd.OpenQuery ("D_EDI_02_OU2")
DoCmd.OpenQuery ("D_EDI_03_EDI_CUSTOMER2")
DoCmd.OpenQuery ("D_EDI_04_CUSTOMER2")
DoCmd.SetWarnings True

'ﾌｧｲﾙ名作成
ExpFileName = "FY24_03_CVJ_EDI" & "_" & Format(Date, "yyyymmdd")
strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xlsx)|*.xlsx", "", ExpFileName & ".xlsx")

'EXCELｱﾌﾟﾘｹｰｼｮﾝを起動
Set xlapp = CreateObject("Excel.Application")

Set myCn = CurrentProject.Connection

strsql1 = "T_EDI_01_CVJ"
strsql2 = "T_EDI_02_OU"
strsql3 = "T_EDI_03_EDI_CUSTOMER"
strsql4 = "T_EDI_04_CUSTOMER"

'ﾚｺｰﾄﾞｾｯﾄｵｰﾌﾟﾝ
myRs.Open strsql1, myCn, adOpenForwardOnly, adLockReadOnly
' myRs.Open strsql2, myCn, adOpenForwardOnly, adLockReadOnly
' myRs.Open strsql3, myCn, adOpenForwardOnly, adLockReadOnly
' myRs.Open strsql4, myCn, adOpenForwardOnly, adLockReadOnly

With xlapp
'ﾃﾝﾌﾟﾚｰﾄを開く
strTemplate = Application.CurrentProject.Path & "\" & "FY24_03_xxx_CVJ_EDI.xlsx"
Set xlWB = .Workbooks.Open(strTemplate)

'ﾃﾝﾌﾟﾚｰﾄﾌｧｲﾙが存在しないときはｴﾗｰ
If Dir(strTemplate) = "" Then
MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー"
.Visible = True
.Quit
Exit Sub
End If

'ﾃﾝﾌﾟﾚｰﾄﾌｧｲﾙｵｰﾌﾟﾝ
.Workbooks.Open strTemplate

'T_EDI_01_CVJの結果値出力処理(1行目にﾍｯﾀﾞｰを表示しているので、2行目1列目からｾｯﾄ
xlWB.Worksheets("CVJ").Rows(2).Insert
xlWB.Worksheets("CVJ").Cells(2, 1).CopyFromRecordset myRs

' 'T_EDI_02_OUの結果値出力処理(1行目にﾍｯﾀﾞｰを表示しているので、2行目1列目からｾｯﾄ
' xlWB.Worksheets("CVJ OU別").Cells(2, 1).CopyFromRecordset myRs

' 'T_EDI_03_EDI_CUSTOMERの結果値出力処理(1行目にﾍｯﾀﾞｰを表示しているので、2行目1列目からｾｯﾄ
' xlWB.Worksheets("代理店別EDIデータ").Cells(2, 1).CopyFromRecordset myRs
'
' 'T_EDI_04_CUSTOMERの結果値出力処理(1行目にﾍｯﾀﾞｰを表示しているので、2行目1列目からｾｯﾄ
' xlWB.Worksheets("当月全代理店事業部別データ").Cells(2, 1).CopyFromRecordset myRs

Dim I As Long

I = 2

xlWB.Worksheets("CVJ").Activate
Do While xlWB.Worksheets("CVJ").Cells(I, 1) <> ""

I = I + 1

Loop

'完了したら保存
If Len(strFileName) = 0 Then
xlWB.Close SaveChanges:=False
xlapp.Quit
MsgBox "処理を中止します。", vbOKOnly + vbInformation

Exit Sub
Else
xlWB.SaveAs FileName:=strFileName

End If

MsgBox "TX Shuttle用ファイルの出力が完了しました。", vbOKOnly + vbInformation

End With

Set myRs = Nothing: Close
Set myCn = Nothing: Close

'Excelを終了します
xlapp.Quit
Exit Sub

Exit_FileDialog_Click:
Exit Sub

Err_FileDialog_Click:
MsgBox "予期せぬエラーが発生しました" & Chr(13) & _
"エラーナンバー：" & Err.Number & Chr(13) & _
"エラー内容：" & Err.Description, vbOKOnly
End

回答No.2

chayamati

他にもありますが、コメント下さい
＞DoCmd.SetWarnings False
はじめは　
　DoCmd.SetWarnings Trueとして実行結果確認します

＞DoCmd.RunSQL "DELETE from T_EDI_01_CVJ"
DoCmd.RunSQL ("DELETE from T_EDI_01_CVJ")
とSQL文を()で括ります()内は　テキスト文なのでコーディング中はチェックされませんが
　実行時にチェックされます

お礼

回答ありがとうございます。
色々やっていたら自己解決いたしました。

複数のテーブルをそれぞれのシートに出力したかったのですが、
レコードを開けっぱなしして、次のテーブルを出力しようとしていたため、エラーが出ていました。

1つのテーブルを出力し終わったら、myRs.Closeで閉じて、次のテーブルを出力すればうまくいきました。

回答No.1

kkkkkm

複数のテーブルを追加クエリなどで一つのテーブルにまとめてからそれをエクセルに出力するという方法なのでしょうか。

お礼

回答ありがとうございます。
色々やっていたら自己解決いたしました。

複数のテーブルをそれぞれのシートに出力したかったのですが、
レコードを開けっぱなしして、次のテーブルを出力しようとしていたため、エラーが出ていました。

1つのテーブルを出力し終わったら、myRs.Closeで閉じて、次のテーブルを出力すればうまくいきました。