在谈到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
答案 0 :(得分:0)
这应该有效:
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