Question

在谈到vba时，我偶尔会出现一些不成熟的事，但我认为这应该是直截了当的？

我正在尝试将oracle db中每个表的内容复制到excel文件中的单独选项卡中。代码从excel文件的第一个选项卡中的列表中获取我想要的表的名称，并将它们放在一个数组中。然后我尝试遍历数组，为每个表创建一个新选项卡并复制数据。该代码适用于第一次通过For Each循环，但总是在尝试打开第二个表的rs时失败。我已经尝试了在循环内外打开和关闭记录集的各种安排无济于事。如果我在复制数据后没有关闭rs我得到一个错误，说它没有关闭到rs.Open（sSQL），con line，如果我关闭连接，我得到一个未指定的错误点....

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复制到excell

1 个答案: