qkoo
2022/07/14 (木) 11:10:27
9fd74@3c75e
情報不足で申し訳ございません。
コード全体は下記です。
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'
アプリケーション定義またはオブジェクト定義エラーです。
通報 ...