Error 1004 Recordset - Help

  • Thread starter Thread starter ina
  • Start date Start date
I

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
 
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
Click to expand...

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
 
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
 
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

RB said:
Yes, probably faster.
Click to expand...

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
 
Back
Top