ADODB Connections

[MChrist]

I'm using the following code to retrieve 4 records from a MS SQL Server 2000
backend db.

What I don't understand is why it takes 4 minutes to run this in Excel, but
only 25 seconds to run the SQL in Query Analyzer. Sure Excel has to make a
DSNless connection, but the problem seems to lie in creating the recordset
and then counting the records retrieved from in the recordset. The code
seems to freeze in the rs.movefirst commands.

I've tried replacing the rs.movefirst and loop with a simple intCtr =
rs.recordcount call, and while that works it still takes a few minutes to
run. Since I have several of these calls to make, I'm beginning to think I
should find another way to do this.

Any thoughts or ideas would be greatly appreciated.

TIA

Mark

Private Sub Get_AI_Data(ByVal dtEnd As Date)
'retrieve Metrics_Results
On Error GoTo Err_Handler

Dim Cnxn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim strCnxn As String

Dim strMsg As String
Dim strSTC As String
Dim strSQL As String
Dim strFL As String
Dim strAI As String

Dim intCtr As Integer
Dim intAddRows As Integer

'clear the current report results and paste the results
Sheets("Metrics Data").Visible = True
Sheets("Metrics Data").Select
Sheets("Metrics Data").Range("Metrics_Results").ClearContents

Set Cnxn = New ADODB.Connection
With Cnxn
.ConnectionString = "Provider=SQLOLEDB;Data Source=MY_SEVER;Initial
Catalog=MY_DB;User Id=MY_USER;Password=MY_PWD;"
.ConnectionTimeout = 0
.Open
End With

Set cmd = New ADODB.Command
With cmd
.ActiveConnection = Cnxn
.CommandText = "SELECT * FROM dbo.fnMetrics_2006('" _
& Format(dtEnd, "mm/dd/yyyy") & "')"
.CommandType = adCmdText
.Execute
End With

'SQL to call from db
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = Cnxn
rs.Open cmd

'if no records retrieved exit
If rs.EOF Then

GoTo Exit_Routine

End If

'count the retrieved records
rs.MoveFirst
Do Until rs.EOF

intCtr = intCtr + 1
rs.MoveNext

Loop
rs.MoveFirst

'size the report range
RowInserter:
If Range("Metrics_Results").Rows.Count < intCtr Then

intAddRows = intCtr - Range("Metrics_Results").Rows.Count

Range(Cells(Range("Metrics_Results").Row + 1,
Range("Metrics_Results").Column), _
Cells(Range("Metrics_Results").Row + intAddRows,
Range("Metrics_Results").Column)).Select

Selection.EntireRow.Insert

ElseIf Range("Metrics_Results").Rows.Count > intCtr _
And Range("Metrics_Results").Rows.Count > 2 Then

Range(Cells(Range("Metrics_Results").Row + 1,
Range("Metrics_Results").Column), _
Cells(Range("Metrics_Results").Row +
Range("Metrics_Results").Rows.Count - 2,
Range("Metrics_Results").Column)).Select

Selection.EntireRow.Delete

GoTo RowInserter

End If

'paste the results
If Not rs.EOF Then
Sheets("Metrics Data").Range("Metrics_Results").CopyFromRecordset rs
End If

Sheets("Metrics Data").Range("A1").Select

Exit_Routine:

rs.Close
Cnxn.Close
Set rs = Nothing
Set Cnxn = Nothing

Exit Sub

Err_Handler:

strMsg = Err.Description

MsgBox "The following error occurred getting the data:" & vbCrLf & vbCrLf
& strMsg

GoTo Exit_Routine

End Sub

 

[quartz]

Just a possible suggestion, try specifying a client side cursor:
Add the following line to your connection "With" clause:

.CursorLocation = adUseClient

HTH/