Populating Oracle SQL Queries in different Sheets in Excel using VBA code

[ygsunilkumar]

Hi, I am trying to populate the 3 different Oracle SQL Queries into 3 Sheets that is "Sheet1, Sheet2, Sheet3". Please help me how do I achieve. Below the code I have tried but it runs only 1 SQL Query. Thanks in Advance.

[VBA]

Private Sub Load_data()
Sheets("Sheet1").Select
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

Sheet1.Activate
Query = "select * from employees where employee_id = 100"

Sheet2.Activate

Query = "select * from employees where employee_id = 200"

Sheet3.Activate
Query = "select * from employees where employee_id = 300"

cn.Open ("User ID= " & UserForm.txtusrname & ";Password=" & UserForm.txtPassword & ";Data Source=" & UserForm.cboInstance & ";Provider=MSDAORA.1")

rs.Open Query, cn

col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

'Now actual data as fetched from select statement
row = 1
Do While Not rs.EOF
row = row + 1
col = 0

Do While col < rs.Fields.Count
Cells(row, col + 1) = rs.Fields(col).Value
col = col + 1
Loop

rs.MoveNext
Loop

End Sub

[/VBA]

[Bob Phillips]

Untested

[vba]

Private Sub Load_data()
Sheets("Sheet1").Select
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Dim mtxData As Variant

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

cn.Open "User ID= " & UserForm.txtusrname & ";" & _
"Password=" & UserForm.txtPassword & ";" & _
"Data Source=" & UserForm.cboInstance & ";" & _
"Provider=MSDAORA.1"

Query = "select * from employees where employee_id = 100"
rs.Open Query, cn
With Sheet1

'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.getrows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With

Query = "select * from employees where employee_id = 200"
rs.Open Query, cn
With Sheet2

'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.getrows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With

Query = "select * from employees where employee_id = 300"
rs.Open Query, cn
With Sheet3

'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.getrows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With
End Sub
[/vba]

[ygsunilkumar]

Hi, Thanks for the code but I got the below error when I run the code. Please help

Run-time error '3705':

Operation is not allowed when the object is open

[Bob Phillips]

Where?

[ygsunilkumar]

here

Query = "select * from employees where employee_id = 200"
rs.Open Query, cn

Run-time error '3705':

Operation is not allowed when the object is open

[Jan Karel Pieterse]

Just before each "end with" you need a

.Close

statement.

[RichardSchollar]

Close rs first before you try to open it again:

Query = "select * from employees where employee_id = 200" 

rs.Close

rs.Open Query, cn

Richard

[Bob Phillips]

Maybe this

[vba]

Private Sub Load_data()
Sheets("Sheet1").Select
Dim cn As ADODB.Connection

Set cn = New ADODB.Connection

cn.Open "User ID= " & UserForm.txtusrname & ";" & _
"Password=" & UserForm.txtPassword & ";" & _
"Data Source=" & UserForm.cboInstance & ";" & _
"Provider=MSDAORA.1"

RunQuery cn, Sheet1, 100
RunQuery cn, Sheet2, 200
RunQuery cn, Sheet3, 300

Set cn = Nothing
End Sub

Private Function RunQuery(cn As ADODB.Connection, ws As Worksheet, limit)
Dim rs As ADODB.Recordset
Dim Query As String
Dim mtxData As Variant
Dim col As Integer
Dim row As Integer

Set rs = New ADODB.Recordset

Query = "select * from employees where employee_id = " & limit
rs.Open Query, cn
With ws

'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.getrows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With

Set rs = Nothing
End Function
[/vba]

[ygsunilkumar]

Hi, the below query is populating all the 3 SQL Queries in the different sheets but data which is populating is column wise(vertically but not horizontally) but I need to populate data as per the original table data. Please help.



[VBA]
Private Sub Load_data()
Sheets("Sheet1").Select
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Dim mtxData As Variant

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

cn.Open "User ID= " & UserForm.txtusrname & ";" & _
"Password=" & UserForm.txtPassword & ";" & _
"Data Source=" & UserForm.cboInstance & ";" & _
"Provider=MSDAORA.1"

Query = ""select * from employees where employee_id = 100'"
rs.Open Query, cn
With Sheet1
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop


mtxData = rs.GetRows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData




End With
rs.Close
Query = ""select * from employees where employee_id = 200'"
rs.Open Query, cn
With Sheet2
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.GetRows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData


End With
rs.Close
Query = ""select * from employees where employee_id = 300'"
rs.Open Query, cn
With Sheet3
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop

mtxData = rs.GetRows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData


End With
End Sub

[/VBA]

I think only this code has to be changed.

[VBA]

mtxData = rs.GetRows
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData

[/VBA]

[Bob Phillips]

Change

[vba]

mtxData = rs.GetRows
[/vba]

to

[vba]

mtxData = Application.Transpose(rs.GetRows)
[/vba]