Error 1004 Recordset - Help

[ina]

Hello I have this function that is very slow and I have although an
error 1004; any suggestion for this issue.

Function GetPriceMonth(ByVal strCode As String)

Dim cmd As ADODB.Command
Dim cndb As ADODB.Connection 'Database connection
Dim rsAssetCode As ADODB.Recordset 'Recordset
Dim retval(10000, 3) As Variant ' this is the array I did to have the
information I decided to do
'if Cells function, and I declared my function () as variant
Dim callfunction As String


Set cndb = GetConnectionADO() 'function to have a connection

Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cndb
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "getMonthPrice"


With cmd
.Parameters.Append .CreateParameter("strCode", adVarChar, _
adParamInput, 30, strCode)
End With

Set rs = cmd.Execute


Dim r As Integer
r = 1

While Not rs.EOF


Cells(r, 0) = rs.Fields(1).Value
Cells(r, 1) = rs.Fields(2).Value
Cells(r, 2) = rs.Fields(3).Value
Cells(r, 3) = "source"
r = r + 1


Debug.Print rs.Fields(1).Value

rs.MoveNext
Wend


'Dim rngNextCell As Range
'Set rngNextCell = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' ************
'Resize the range to set the retval
' *************
'rngNextCell.Resize(UBound(retval, 1) - LBound(retval, 1) + 1,
UBound(retval, 2) - LBound(retval, 2) + 1).Value = retval

' ************
' call the function
'*************

'GetPriceMonth = retval

callfunction = GetPriceMonth

cndb.Close
Set cmd = Nothing
Set cndb = Nothing

End Function

 

[RB Smissaert]

The trouble is this loop:

While Not rs.EOF


Cells(r, 0) = rs.Fields(1).Value
Cells(r, 1) = rs.Fields(2).Value
Cells(r, 2) = rs.Fields(3).Value
Cells(r, 3) = "source"
r = r + 1


Debug.Print rs.Fields(1).Value

rs.MoveNext
Wend

Look in the help at the GetRows method of the RecordSet.

Using that you would do instead something like this:

Dim arr

'can leave the Transpose out if you don't need it
arr = WorksheetFunction.Transpose(rs.GetRows)

Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2) + 1)) = arr

And that is much faster.


RBS

 

[Nate Oliver]

Hello,

Where's the error? I suspect using the CopyFromRecordset Method would
be faster than the GetRows()/Transpose() combination... See the
following:

http://msdn.microsoft.com/library/en-us/vbaxl11/html/xlmthCopyFromRecordset1_HV05200141.asp

Cheers,
Nate Oliver

 

[RB Smissaert]

Yes, probably faster.
I work so much with arrays that I forgot about that one.
Anything is better though than looping through the RecordSet.

RBS

 

[Nate Oliver]

Hello again,

Don't get me wrong, GetRows() has it's place, and I've used it before,
e.g.,

http://www.utteraccess.com/forums/showflat.php?Number=1146152&fpart=4.6

Yes, probably faster.

But yes, I suspect so... And simpler, especially considering how
Transpose() will bomb if any of your fields values are Null, wheras
CopyFromRecordset can handle this, e.g.,

Sub foo()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs
' Add field definitions...
.Fields.Append "ID", adInteger
.Fields.Append "Value", adVarChar, 200, adFldIsNullable
'Open her up
.Open , , adOpenStatic, adLockOptimistic
'Add new record
.AddNew
'Add Values
.Fields(0).Value = 3: .Fields(1).Value = "Tester"
'Add new record
.AddNew
'Add Values
.Fields(0).Value = 33: .Fields(1).Value = Null
'Add new record
.AddNew
'Add Values
.Fields(0).Value = 1998: .Fields(1).Value = "foobar"
'Update the record set
.Update
'Pass it
.MoveFirst
Range("a1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub

Regards,
Nate Oliver

 

[ina]

Thank you guys really appreciate it.

Ina

 

[RB Smissaert]

Yes, use CopyFromRecordset, no need to convince me.
Just hadn't thought of it.

RBS