Access VBA Excel エクスポート

質問

Access VBAにてExcel エクスポートの処理を記述しました。
現在の記述だと、出力対象のテーブル（クエリ）ごとに１つのファイルとなっており、ファイルの管理が大変なため、１つのExcelファイルで、複数シートに出力したいのですが、どこを修正すればよろしいでしょうか？
’出力対象のクエリ名が入っている配列の要素数（出力対象のクエリ数）を取得する
j = UBound(QName)
’出力するクエリの分だけ繰り返す
For i = 0 To j
　 ’同じファイル名のＥｘｃｅｌファイルが見つかった場合
If Dir(Path & EName(i)) <> "" Then
'データ更新のため、見つかったファイルを削除する
Kill Path & EName(i)
End If
　 ’出力対象のクエリにデータ（レコード）が存在する場合
If Count(i) > 0 Then
'Ｅｘｃｅｌファイルを再度作成する
　　’Qname(i)が出力するクエリ名、Pathが出力先のパス、Ename(i)が出力ファイル名です。
DoCmd.TransferSpreadsheet acExport, 10, QName(i), Path & EName(i), True, ""
End If
End If
Next

回答No.2

piroin654 · ベストアンサー

>出力対象のテーブル（クエリ）ごとに１つのファイルとなっており、
>ファイルの管理が大変なため、１つのExcelファイルで、複数シート
>に出力したい

とのことなので、以下ではどうですか。

strPath、およびstrFileNameは適当に設定してください

Sub cmdRecCountAndExport()
　　Dim db As DAO.Database
　　Dim qdf As DAO.QueryDef
　　Dim myQdfName As Variant
　　Dim strSQL As String
　　Dim i As Long
　　Dim strPath As String
　　Dim strFileName As String

　　strPath = "C:\Users\ほげほげ\Desktop\置場\"
　　strFileName = "データ保存.xlsx"

　　Set db = CurrentDb
　　　　For Each qdf In db.QueryDefs
　　　　　　If Left(qdf.Name, 1) <> "~" Then
　　　　　　　　'選択クエリとクロス集計クエリを選ぶ
　　　　　　　　If qdf.Type = 0 Or qdf.Type = 16 Then
　　　　　　　　　　'パラメータが設定してあるものを除外
　　　　　　　　　　If qdf.Parameters.Count = 0 Then
　　　　　　　　　　　　'レコード件数が0のものを除外
　　　　　　　　　　　　If funcRecCount(qdf.Name) > 0 Then
　　　　　　　　　　　　　　If Dir(strPath & strFileName) <> "" Then
　　　　　　　　　　　　　　　　Kill strPath & strFileName
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　'Excelへのエクスポート
　　　　　　　　　　　　　　DoCmd.TransferSpreadsheet acExport, 10, qdf.Name, strPath & strFileName, True
　　　　　　　　　　　　　　i = i + 1
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Next qdf
　　　　If i = 0 Then
　　　　　　MsgBox "エクスポートの対象となるクエリは存在しません"
　　　　End If
　　Set qdf = Nothing
　　db.Close: Set db = Nothing
End Sub

'レコード件数を求める関数
Private Function funcRecCount(ByVal strQueryName As String) As Long
　　Dim db As DAO.Database
　　Dim rs As DAO.Recordset
　　Dim strSQL As String

　　strSQL = "SELECT COUNT(*) AS RecCnt FROM " & strQueryName
　　Set db = CurrentDb
　　Set rs = db.OpenRecordset(strSQL)
　　funcRecCount = rs!RecCnt

　　rs.Close: Set rs = Nothing
　　db.Close: Set db = Nothing
End Function

この場を借りてですが、

https://okwave.jp/qa/q9690744.html

で回答した中で、

　　　　　　　　'選択クエリとクロス集計クエリを選ぶ
　　　　　　　　If qdf.Type = 0 Or qdf.Type = 16 Then
　　　　　　　　　　ReDim Preserve myQdfName(i)
　　　　　　　　　　myQdfName(i) = qdf.Name
　　　　　　　　　　i = i + 1
　　　　　　　　End If

を、

　　　　　　　　'選択クエリとクロス集計クエリを選ぶ
　　　　　　　　If qdf.Type = 0 Or qdf.Type = 16 Then
　　　　　　　　　　'パラメータが設定してあるものを除外
　　　　　　　　　　If qdf.Parameters.Count = 0 Then
　　　　　　　　　　　　ReDim Preserve myQdfName(i)
　　　　　　　　　　　　myQdfName(i) = qdf.Name
　　　　　　　　　　　　i = i + 1
　　　　　　　　　　End If
　　　　　　　　End If

のように変更してください。クエリにパラメータがあると
データが確定できないのではずします。
同様に、この回答でもそのような処置を行っています。

回答No.1

HohoPapa

未確認ですが、以下はいかがでしょうか。

　j = UBound(QName)

　For i = 0 To j

　　If Count(i) > 0 Then
　　　DoCmd.TransferSpreadsheet acExport, 10, QName(i), _
　　　　"C:\test\Test.xlsx", True, "Sh" & Format(i, "0")
　　End If

　Next

お礼

ご回答いただきまして誠にありがとうございました。
実行してみたところ、コンパイルエラーとなってしまいました。
申し訳ありません。