https://docs.microsoft.com/ja-jp/office/vba/api/access.docmd.transferspreadsheet?f1url=%3FappId%3DDev11IDEF1%26l%3Dja-JP%26k%3Dk(vbaac10.chm4189);k(TargetFrameworkMoniker-Office.Version%3Dv15)%26rd%3Dtrue
Range引数 のヘルプには、
引用:
スプレッドシートにエクスポートする場合は、この引数を空白のままにする必要があります。 範囲を入力すると、エクスポートは失敗します。
とあります。
実際に、Rangeを指定すると、エラーになります。
オートメーションにてエクスポートする方法です。
Sub Sumple()
Dim Path As String
Dim rs As Object
Dim xlsApp As Object
Dim xlsWbk As Object
Dim xlsWst As Object
Dim i As Long
Path = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & "末日.xlsx"
'レコードセットを開く
Set rs = CurrentDb.OpenRecordset("末日")
'レコードセットにレコードがあるか確認
If rs.RecordCount > 0 Then
'Excelアプリケーション生成
Set xlsApp = CreateObject("Excel.Application")
'Path のファイルの存在を確認
If Len(Dir(Path)) > 0 Then
'存在する場合、そのファイルを開く
Set xlsWbk = xlsApp.workbooks.Open(Path)
Else
'存在しない場合
'ファイルを作成する
Set xlsWbk = xlsApp.workbooks.Add
'ファイルを名前をつけて保存
xlsWbk.SaveAs Path
End If
'ワークブックの全シートをループ
For Each xlsWst In xlsWbk.Worksheets
'シート名が「末日」の場合
If xlsWst.Name = "末日" Then
'ループを抜ける
Exit For
End If
Next
'xlsWst の 参照確認
If xlsWst Is Nothing Then
'無い場合、ワークシート存在しないので
'ワークシートを追加
Set xlsWst = xlsWbk.Worksheets.Add
'シート名を「末日」に変更
xlsWst.Name = "末日"
End If
'A3〜 フィールド名を設定
For i = 0 To rs.Fields.Count - 1
xlsWst.Cells(3, i + 1).Value = rs.Fields(i).Name
Next
'A4〜 レコードセットの中身を貼付
xlsWst.Cells(4, 1).CopyFromRecordset rs
'ワークブック上書き保存
xlsWbk.Save
'Excel オブジェクト破棄
Set xlsWst = Nothing
Set xlsWbk = Nothing
Set xlsApp = Nothing
End If
'レコードセット オブジェクト破棄
rs.Close
Set rs = Nothing
End Sub
