第二次通过循环将数据从 oracle 复制到 excel 时出错

Question

在谈到 vba 时，我是一个非常偶然的成熟人士，但我认为这应该是直截了当的？

我正在尝试将 oracle 数据库中每个 table 的内容复制到 excel 文件中的单独选项卡中。该代码从 excel 文件的第一个选项卡中的列表中获取我想要的 table 的名称，并将它们放入一个数组中。然后我尝试遍历数组，为每个 table 创建一个新选项卡并复制数据。该代码在第一次通过 For Each 循环时有效，但在它尝试为第二次 table 打开 rs 时总是失败。我已经尝试了在循环内外打开和关闭记录集的各种安排，但都无济于事。如果我在复制数据后没有关闭 rs，我会收到一条错误消息，指出它在到达 rs.Open (sSQL) 时未关闭，con 行，如果我确实关闭了连接，我会收到一个未指定的错误相同点....

Sub Ora_Connection()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String            ' a string to contain the db connection data
Dim myTABLELIST As Variant         ' a variant to contain the list of oracle tables that contain data that we want to copy to excel
Dim lArr As Variant


' copy contents of TABLELIST into vb array
myTABLELIST = Worksheets("TABLE_LIST").ListObjects("TABLELIST").DataBodyRange.Value


' add a tab for every table in list
For Each lArr In myTABLELIST

        ' connect to oracle db
        Set con = New ADODB.Connection
         con.CursorLocation = adUseClient ' avoid error 3705 - doesn't do anything
        Set rs = New ADODB.Recordset
        '---- Replace HOST and COONECT_DATA with values for the db you are connecting to
        strCon = "Driver={Microsoft ODBC for Oracle}; " & _
        "CONNECTSTRING=(DESCRIPTION=" & _
        "(ADDRESS=(PROTOCOL=TCP)" & _
        "(HOST=myHost)(PORT=1521))" & _
        "(CONNECT_DATA=(SID=mySID))); uid=myUID; pwd=myPWD;"
        '---  Open   the above connection string.
        con.Open (strCon)
        '---  Now connection is open and you can use queries to execute them.
        '---  It will be open till you close the connection

        ' make the connection able to travel only forwards through the recordset, so the query runs faster
        rs.CursorType = adOpenForwardOnly



    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = lArr

    'creat SQl statement that uses table name in array
    sSQL = "SELECT * FROM " & lArr
    'If Not rs.State = adStateClosed Then
    'MsgBox "The recordset is already open"
    'End If
    rs.Open (sSQL), con
    Worksheets(lArr).Activate
    ' copy column header from source data into row 1
    For iCols = 0 To rs.Fields.Count - 1
     ActiveSheet.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
    Next
    ' copy all data rows from source data into range starting at A2
    ActiveSheet.Range(ActiveSheet.Cells(1, 1), _
     ActiveSheet.Cells(1, rs.Fields.Count)).Font.Bold = True
    ActiveSheet.Range("A2").CopyFromRecordset rs


Next lArr



' clear recordset and close connection
Set rs = Nothing
Set con = Nothing

End Sub

Answer 1

这应该有效：

Sub Ora_Connection()

    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim myTABLELIST As Variant, strCon As String, iCols As Long
    Dim lArr As Variant, ws As Worksheet, r As Long, wb As Workbook

    Set wb = ThisWorkbook

    myTABLELIST = wb.Worksheets("TABLE_LIST").ListObjects("TABLELIST").DataBodyRange.Value

    Set con = New ADODB.Connection
    strCon = "yourConnectionInfoHere"
    con.Open strCon

    ' add a tab for every table in list
    For r = 1 To UBound(myTABLELIST, 1)

        lArr = myTABLELIST(r, 1)

        Set rs = con.Execute("SELECT * FROM " & lArr)
        Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
        ws.Name = lArr
        For iCols = 0 To rs.Fields.Count - 1
            ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
        Next
        ws.Cells(1, 1).Resize(1, rs.Fields.Count).Font.Bold = True
        If Not rs.EOF Then ws.Range("A2").CopyFromRecordset rs

    Next r

    Set rs = Nothing
    con.Close
    Set con = Nothing

End Sub

第二次通过循环将数据从 oracle 复制到 excel 时出错

error on second pass through loop copying data from oracle to excell

excel

vba

loops

recordset

oracle-sqldeveloper