Dear Friends,
I am trying to run SQL queries on Oracle server from macro. However, the queries which takes 2 minutes to execute on SQL developer runs indefinitely from macro. On the other hand queries like "select * from dual" or simple count queries running within seconds runs fine. Please help me, anyone. it's urgent.
Below is the macro code.
Sub Macro()
Dim DBcon As ADODB.Connection
Dim DBrs As ADODB.Recordset
Dim DBrs1 As ADODB.Parameters
Set DBcon = New ADODB.Connection
Set DBrs = New ADODB.Recordset
Dim DBsource As String
Dim DBuid As String
Dim DBpwd As String
Dim DBQuery As String
Dim ConString As String
Dim ConnName As String
Dim Row As Integer
Dim NoOfFields As Integer
Dim NoOfSheets As Integer
Dim StartDate As Date
Dim FinishDate As Date
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws_log = Sheets(ActiveWorkbook.Worksheets("Login Details").Name)
DBsource = ws_log.Cells(6, 2)
DBuid = InputBox("Enter Database User Name")
DBpwd = InputBox("Enter Database Password")
ws_log.Cells(5, 5).Value = Now
StartDate = Now
'Syntax to connect with Oracle server
ConString = "Provider=OraOLEDB.Oracle;Data Source=" & DBsource & ";User ID=" & DBuid & ";Password=" & DBpwd
'Using this property of recordset Record Count would come properly
DBrs.CursorLocation = adUseClient
On Error Resume Next
'Establish the Databse connection
DBcon.Open (ConString)
If DBcon.State = 1 Then
MsgBox ("Connected")
ws_log.Cells(8, 5).Value = "SUCCESS"
For NoOfSheets = 2 To 2
Set ws = Sheets(ActiveWorkbook.Worksheets(NoOfSheets).Name)
ws.Activate
Set ws2 = Sheets("IMBLR_Data")
ws2.Activate
Row = 1
Do While ws.Cells(Row, 1).Value <> ""
ws.Cells(Row, 1).Select
DBQuery = ws.Cells(Row, 1).Value
DBrs.Open DBQuery, DBcon
'Loop to iterate if multiple rows are returned by the query
Do While Not DBrs.EOF
'Loop to iterate if query returns multiple columns
For NoOfFields = 0 To DBrs.Fields.Count - 1
ws2.Cells(2, 1 + NoOfFields).Value = DBrs.Fields(NoOfFields).Value
Next
DBrs.MoveNext
Loop
Row = Row + 1
DBrs.Close
ConnName = cbCons
ActiveWorkbook.Save
Loop
Next
Else
ws_log.Cells(8, 5).Value = "FAIL"
End If
ws_log.Cells(6, 5).Value = Now
FinishDate = Now
ws_log.Cells(7, 5).Value = DateDiff("n", FinishDate, StartDate) & " minutes"
ActiveWorkbook.Save
DBcon.Close
End Sub
