I am a very occasional amature when it comes to vba but I would have thought this should be straight forward?
I am trying to copy the contents of each table in an oracle db into separate tabs in an excel file. The code gets the names of the tables I want from a list in the first tab of the excel file and puts them in an array. I am then trying to loop through the array, creating a new tab for each table and copying the data across. The code works for the first pass through the For Each loop but always fails at the point where it tries to open the rs for the 2nd table. I have tried various arrangements of the recordset opening and closing inside and outside the loop to no avail. If I don't close the rs after copying the data across I get an error saying its not closed when it gets to the rs.Open (sSQL), con line, if I do close the connection I get an unspecified error at the same point....
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
This should work:
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