Microsoft Access 掲示板

AccessからExcelへ出力する際にエラー

8 コメント
views
4 フォロー

excelのテンプレートファイルにAccessからデータを出力するとエラーになります。

以下のコードで出力しています。

Do Until rs.EOF

            '行コピー
            .Worksheets(1).rows(line_no & ":" & line_no).Select
            .Selection.Copy
            .Worksheets(1).rows(line_no & ":" & line_no + 1).Select
            .Worksheets(1).Paste
            .Application.CutCopyMode = False

            .Cells(line_no, 1).Value = rs!A
            .Cells(line_no, 2).Value = rs!B
            .Cells(line_no, 3).Value = rs!C
            .Cells(line_no, 4).Value = rs!D
            .Cells(line_no, 5).Value = rs!E
            .Cells(line_no, 6).Value = rs!F
            .Cells(line_no, 7).Value = rs!G
            .Cells(line_no, 8).Value = rs!H
            .Cells(line_no, 9).Value = rs!I
            .Cells(line_no, 10).Value = rs!J
            .Cells(line_no, 11).Value = rs!K
            .Cells(line_no, 12).Value = rs!L
            .Cells(line_no, 13).Value = rs!M
            .Cells(line_no, 14).Value = rs!N
            .Cells(line_no, 15).Value = rs!O
            .Cells(line_no, 16).Value = rs!P
            .Cells(line_no, 17).Value = rs!Q
            .Cells(line_no, 18).Value = rs!R
            .Cells(line_no, 19).Value = rs!S
            .Cells(line_no, 20).Value = rs!T

            line_no = line_no + 1
            rs.MoveNext

Loop

何がいけないでしょうか。現状検証していると、line_no=34のときにエラー(1004)となり止まります。

qkoo
作成: 2022/07/12 (火) 17:31:27
最終更新: 2022/07/12 (火) 17:31:52
通報 ...
1

コードの抜粋ではなく、コード全体を提示してください。

また、どの行でエラーが出るのか、エラーが出たときにエラーメッセージも提示してください。

あと、下記の部分は何を意図したコードか説明してください。

            .Worksheets(1).rows(line_no & ":" & line_no).Select
            .Selection.Copy
            .Worksheets(1).rows(line_no & ":" & line_no + 1).Select
            .Worksheets(1).Paste
2

情報不足で申し訳ございません。
コード全体は下記です。

    Dim sql As String: sql = ""
    Dim rs As ADODB.Recordset
    Dim cn AS ADODB.Connection
    Dim fn As String: fn = ""
    Dim template_fn As String: template_fn = "ファイル名"
    Dim tf_path As String: tf_path = CurrentProject.Path & "\" & template_fn & ".xlsx"
    Dim xl_app As Object
    Dim line_no As Long: line_no = 4
    
    sql = ""
    sql = sql & "SELECT A,B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U "
    sql = sql & "FROM T_TEST "
	
    set rs = new ADODB.Recordset	
    set cn = Currentproject.Connection

    rs.open sql,cn,adOpenStatic,adLockReadOnly
    
    Set xl_app = CreateObject("Excel.Application")
    
    xl_app.Visible = False '可視設定
    
    With xl_app
        
        If Dir(tf_path) = "" Then
            
            MsgBox "ファイルなし"
            .Quit
            Exit Sub
        End If
        .Workbooks.Open tf_path
        Do Until rs.EOF
            
            '書式入り行コピー
            .rows(line_no & ":" & line_no).Select
            .Selection.Copy
            .rows(line_no & ":" & line_no + 1).Select
            .ActiveSheet.Paste
            .Application.CutCopyMode = False
            
            .cells(line_no, 1) = rs!A 'ここでエラー
            .cells(line_no, 2) = rs!B
            .cells(line_no, 3) = rs!C
            .cells(line_no, 4) = rs!D
            .cells(line_no, 5) = rs!E
            .cells(line_no, 6) = rs!F
            .cells(line_no, 7) = rs!G
            .cells(line_no, 8) = rs!H
            .cells(line_no, 9) = rs!I
            .cells(line_no, 10) = rs!J
            .cells(line_no, 11) = rs!K
            .cells(line_no, 12) = rs!L
            .cells(line_no, 13) = rs!M
            .cells(line_no, 14) = rs!N
            .cells(line_no, 15) = rs!O
            .cells(line_no, 16) = rs!P
            .cells(line_no, 17) = rs!Q
            .cells(line_no, 18) = rs!R
            .cells(line_no, 19) = rs!S
            .cells(line_no, 20) = rs!T
            .cells(line_no, 21) = rs!U
            
            line_no = line_no + 1
            rs.MoveNext
            
        Loop
        
        .rows(line_no & ":" & line_no).Delete
        .Range("A1").Select
        .Visible = True
        
    End With
    
    rs.close

エラーメッセージは下記の通りです。
実行時エラー'1004'
アプリケーション定義またはオブジェクト定義エラーです。

3

まずは、動作確認中(デバッグ中)は、エクセルを表示させて実行しましょう。

'    xl_app.Visible = False '可視設定
    xl_app.Visible = True

エラーが出て中断すると、非表示のエクセルの残ってしまいますので。非表示のエクセルはPCをシャットダウンしないかぎり、閉じるのが難しいので。

エラーが出る前の行に下記のようなデバッグ用のコードを挿入して実行してみてください。

           Debug.Print rs!A.Value
           Debug.Print line_no
           Debug.Print .cells(line_no, 1).Address
           .cells(line_no, 1) = rs!A 'ここでエラー

これでエラーが出て中断したときのイミディエイトウィンドウに出力されたものをコピーしてもらえますか。
それで原因がわかるかもしれません。

4

遅くなり申し訳ございません。

イミディエイトウィンドウに表示されたのは下記です。
AAAA-AAAAA-AAA
 33
$A$33

5

その結果から判断するかぎりは、エラーがでるのは考えにくいですね。
ちょっとお役に立てそうにないです。

6

お付き合いいただきありがとうございました。

処理が中断した後、F5を押すと、処理は続くので何が原因なのか判断できない状況です。
(一定数コピペが進むとまた止まります。)
あまり良い方法ではないと思いますが、DoEventsを挟んで一時的に対応したいと思います。
(DoEventsを挟むと最後まで処理は進みます。遅いですが。)

7

コードを見ると、sqlから生成されたレコードセットをそのままシート上に出力するもののようですので、
CopyFromRecordsetメソッドを利用すると、1行のコードでできると思います。処理速度も高速です。

下記が参考になります。

■T'sWare Access Tips #686 〜レコードセットの内容をそのままExcelのシートに出力する方法〜
Tsware

8
hiroton 2022/07/21 (木) 08:38:49 0ef9f@f966d

こうしてみたらどうでしょう?

    Dim sql As String: sql = ""
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim fn As String: fn = ""
    Dim template_fn As String: template_fn = "ファイル名"
    Dim tf_path As String: tf_path = CurrentProject.Path & "\" & template_fn & ".xlsx"
    Dim xl_app As Object
    Dim line_no As Long: line_no = 4
    
    sql = ""
    sql = sql & "SELECT A,B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U "
    sql = sql & "FROM T_TEST "
    
    Set rs = New ADODB.Recordset
    Set cn = CurrentProject.Connection

    rs.Open sql, cn, adOpenStatic, adLockReadOnly
    
    Set xl_app = CreateObject("Excel.Application")
    
    xl_app.Visible = False '可視設定
    
    With xl_app
        
        If Dir(tf_path) = "" Then
            
            MsgBox "ファイルなし"
            .Quit
            Exit Sub
        End If
'//        .Workbooks.Open tf_path
        With .Workbooks.Open(tf_path)
        With .Activesheet
        Do Until rs.EOF
            
            '書式入り行コピー
            .Rows(line_no & ":" & line_no).Select
            .Selection.Copy
            .Rows(line_no & ":" & line_no + 1).Select
'//            .Activesheet.Paste
            .Paste
            .Application.CutCopyMode = False
            
            .cells(line_no, 1) = rs!A 'ここでエラー
            .cells(line_no, 2) = rs!B
            .cells(line_no, 3) = rs!c
            .cells(line_no, 4) = rs!d
            .cells(line_no, 5) = rs!E
            .cells(line_no, 6) = rs!f
            .cells(line_no, 7) = rs!G
            .cells(line_no, 8) = rs!H
            .cells(line_no, 9) = rs!i
            .cells(line_no, 10) = rs!j
            .cells(line_no, 11) = rs!K
            .cells(line_no, 12) = rs!L
            .cells(line_no, 13) = rs!M
            .cells(line_no, 14) = rs!n
            .cells(line_no, 15) = rs!O
            .cells(line_no, 16) = rs!P
            .cells(line_no, 17) = rs!Q
            .cells(line_no, 18) = rs!R
            .cells(line_no, 19) = rs!s
            .cells(line_no, 20) = rs!T
            .cells(line_no, 21) = rs!u
            
            line_no = line_no + 1
            rs.MoveNext
            
        Loop
        
        .Rows(line_no & ":" & line_no).Delete
        .Range("A1").Select
        .Visible = True
        
        End With
        End With
    End With
    
    rs.Close

※コードの善し悪しは評価していません


Excel処理の問題のようなので、この掲示板(ACCESS掲示板)よりもExcelに強い場所で質問するとうまく解決できるかもしれませんね