Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Access 2016)
Excel(.xlsx)でエクスポートした際にセル指定してデータ出力する。
投稿日時: 20/10/18 23:00:00
投稿者: やっほー

件名につきまして、
エクスポートした際にシート名やファイル名を指定することが出来ますが、
データのはじまりを指定したいです。
例えば、ExcelファイルのはじまりがA3から出力することが出来れば幸いです。
宜しくお願い致します。
 
Private Sub Excel出力_Click()
    Dim Path As String
    Path = CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & "末日.xlsx"
     
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Q_末日", Path, False, "末日"
    MsgBox "Excel出力しました"
 
End Sub

回答
投稿日時: 20/10/19 09:45:29
投稿者: Suzu

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

投稿日時: 20/10/19 10:43:17
投稿者: やっほー

ご連絡ありがとうございます。
コマンドボタンにソースコードを入力して実行すると
Excelファイルはエクスポートされますが、
〜$末日.xlsxのファイルもエクスポートされ、開いている状態になり、
閉じることもできず、削除も出来ません。
よろしくお願いします。

回答
投稿日時: 20/10/19 13:11:35
投稿者: Suzu

引用:
開いている状態になり、閉じることもできず、削除も出来ません。
すみません。
ワークブックファイルを閉じる、アプリケーションを終了する処理が抜けていました。
 
        'ワークブック上書き保存
        xlsWbk.Save
    xlsWbk.Close
        xlsApp.Quit

 
        'Excel オブジェクト破棄
        Set xlsWst = Nothing
        Set xlsWbk = Nothing
        Set xlsApp = Nothing
 
赤字を追加してください。

投稿日時: 20/10/19 13:44:09
投稿者: やっほー

ご連絡ありがとうございます。
解決致しました。
本当にありがとうございました。