@0tgrposted at 2022-09-08

accessでexcelを１行ずつコピペしたい

Q&A

解決したいこと

AccessDBの内容をテンプレートのExcelへ出力したいです。
レコード数が可変なので、処理開始時にExcelの1行目をコピーして次の行に貼り付ける処理をしていますが、定期的に『実行時エラー'1004':アプリケーション定期またはオブジェクト定義のエラーです。』が出力されます。
デバッグ⇒継続(F5)をした場合処理が継続し、最終的な出力結果は(多分)問題ないです
(しっかりとは確認できていませんが...)

エラー発生せずに最後まで処理を行うにはどの様に修正すればよいかご教授ください。

現状のエラー発生するコード

Dim tmp_file, file_name As String
Dim FILENM, FILENM2 As String
Dim xlApp As Object

~~~~
accessDBからデータ抽出処理
~~~~

' EXCELを起動
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

With xlApp
    ' ファイルが存在しない場合エラー
    If Dir(FILENM2) = "" Then
    MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー"
    .Visible = True
    .Quit
    Exit Sub
    End If
    
    ' ファイル開く
    .Workbooks.Open FILENM2

    ' レコードをExcelに出力
    rs.MoveFirst
    intRow = 16
    
    Do Until rs.EOF
        ' セルの書式コピー ↓ここでエラー発生※
        .Worksheets("Sheet1").Rows(intRow).Copy (.Worksheets("Sheet1").Rows(intRow + 1))
        ~~~~
        抽出したデータをExcelに出力
        ~~~~   

        intRow = intRow + 1
        rs.MoveNext
    Loop

    rs.Close
    .ActiveWorkbook.Save
    End With

簡略化して記載しています。
テンプレートのExcelファイルが16行目から出力開始なのでintRow = 16にしています。
AccessDBから抽出したレコード数は600件弱で60～100件周期でエラー発生し処理が止まってしまいます。

.Worksheets("Sheet1").Rows(intRow).Copy (.Worksheets("Sheet1").Rows(intRow + 1))

↑ この部分で実行時エラー1004が発生します。

実行環境

Microsoft® Excel® for Microsoft 365 MSO (バージョン 2207 ビルド 16.0.15427.20166) 32 ビット
Microsoft® Access® for Microsoft 365 MSO (バージョン 2207 ビルド 16.0.15427.20166) 32 ビット

自分で試したこと

グーグル先生で調べて出てきた以下のようなセルをコピーする系の書き方は試してみましたがうまくいきませんでした...。

.Worksheets("Sheet1").Rows(intRow).Copy
.Worksheets("Sheet1").Rows(intRow + 1).PasteSpecial

Are you sure you want to delete the question?