Question

我正在研究这段代码，以通过从访问表中读取并写入excel工作表来自动执行“复制粘贴”操作。与访问表不同的值需要在excel工作表的特定单元格中写入。我的问题是代码通过读取和写入第一个值，而不是第二个++值来工作。

第一个值正确地写在Excel中的E15上，但是没有写出应该写在单元格E16上的第二个值，为什么？

Sub HentData()

Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
Dim Sum As Double

DBFullName = "C:\saga_effekt_Nidaros_2017_tiltak.mdb"

Application.ScreenUpdating = False

Set TargetRange = Sheets("1.3 Persontransportmodell").Range("A1")

Set cn = CreateObject("ADODB.Connection")

cn.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=C:\saga_effekt_Nidaros_2017_tiltak.mdb;"

Set rs = CreateObject("ADODB.Recordset")

rs.Open "SELECT [VERDI] FROM [saga_trafikantnytte] WHERE [REISEMIDDE] = 'tog' AND [VARIABEL] = 'sum'", cn, , , adCmdText

For intColIndex = 0 To rs.Fields.Count - 1
    'TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
    Next

TargetRange.Offset(14, 4).CopyFromRecordset rs

 Application.ScreenUpdating = True

    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    On Error GoTo 0
    Exit Sub

rs.Open "SELECT [VERDI] FROM [saga_trafikantnytte] WHERE [REISEMIDDE] = 'tog' AND [VARIABEL] = 'referansetrafikk'", cn, , , adCmdText

For intColIndex = 0 To rs.Fields.Count - 1
    'TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
    Next

TargetRange.Offset(15, 4).CopyFromRecordset rs

 Application.ScreenUpdating = True

    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    On Error GoTo 0
    Exit Sub

End Sub

我没有收到任何错误消息，代码可以运行，但是输出不完整。

Answer 1

尝试一下：

dnorm

Answer 2

这是对您原始代码的修改，该代码应该可以使用。无需调用第一个Exit Sub。第二个也是不必要的，因为您没有任何错误处理代码。

此外，您无需关闭连接或丢弃rs直到结束。

Sub HentData()

Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
Dim Sum As Double

DBFullName = "C:\saga_effekt_Nidaros_2017_tiltak.mdb"
Application.ScreenUpdating = False
Set TargetRange = Sheets("1.3 Persontransportmodell").Range("A1")

Set cn = CreateObject("ADODB.Connection")
cn.Open "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=C:\saga_effekt_Nidaros_2017_tiltak.mdb;"

Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT [VERDI] FROM [saga_trafikantnytte] WHERE [REISEMIDDE] = 'tog' AND [VARIABEL] = 'sum'", cn, , , adCmdText

For intColIndex = 0 To rs.Fields.Count - 1
    'TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
Next
TargetRange.Offset(14, 4).CopyFromRecordset rs
Application.ScreenUpdating = True

On Error Resume Next
rs.Close
On Error GoTo 0

rs.Open "SELECT [VERDI] FROM [saga_trafikantnytte] WHERE [REISEMIDDE] = 'tog' AND [VARIABEL] = 'referansetrafikk'", cn, , , adCmdText

For intColIndex = 0 To rs.Fields.Count - 1
    'TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
Next
TargetRange.Offset(15, 4).CopyFromRecordset rs
Application.ScreenUpdating = True

On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0

End Sub

如何修复此代码？它将第一个参数写入文件，为什么不写入第二个参数？

2 个答案: