Microsoft Access 掲示板

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

8 コメント
views
4 フォロー
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に強い場所で質問するとうまく解決できるかもしれませんね

通報 ...