Copy an array into an ADO recordset?

[quartz]

I have the following function in which I am attempting to copy an array into
an ADO recordset directly from the current sheet in Excel. This generates an
error. Can this even be done? If so, how? Can someone please correct my
function?

Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As Object
Dim lngR As Long
Dim lngC As Long
Set rsADO = CreateObject("ADODB.Recordset.2.8")
For lngR = 1 To UBound(argArray, 1)
For lngC = 1 To UBound(argArray, 2)
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
rsADO.MoveNext
Next lngR
End Function

Thanks much in advance.

 

[Fredrik Wahlgren]

I have the following function in which I am attempting to copy an array into
an ADO recordset directly from the current sheet in Excel. This generates an
error. Can this even be done? If so, how? Can someone please correct my
function?

Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As Object
Dim lngR As Long
Dim lngC As Long
Set rsADO = CreateObject("ADODB.Recordset.2.8")
For lngR = 1 To UBound(argArray, 1)
For lngC = 1 To UBound(argArray, 2)
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
rsADO.MoveNext
Next lngR
End Function

Thanks much in advance.

I think you should use Set rsADO = CreateObject("ADODB.Recordset")
Do you get an error message?

/Fredrik

 

[Fredrik Wahlgren]

I have the following function in which I am attempting to copy an array into
an ADO recordset directly from the current sheet in Excel. This generates an
error. Can this even be done? If so, how? Can someone please correct my
function?

Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As Object
Dim lngR As Long
Dim lngC As Long
Set rsADO = CreateObject("ADODB.Recordset.2.8")
For lngR = 1 To UBound(argArray, 1)
For lngC = 1 To UBound(argArray, 2)
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
rsADO.MoveNext
Next lngR
End Function

Thanks much in advance.

I think the code should be something like this

Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As Object
Dim lngR As Long
Dim lngC As Long
Set rsADO = CreateObject("ADODB.Recordset")
For lngR = 1 To UBound(argArray, 1)
rsADO.AddNew
For lngC = 1 To UBound(argArray, 2)
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
Next lngR
Set ADOCopyArrayIntoRecordset = rsADO
End Function

 

[Rob Bovey]

Hi Quartz,

You need to do two a number of thing to correct your code. After
creating the new recordset object you must attach the appropriate number of
fields with the right data types, etc to the recordset using
rsADO.Fields.Append.

Prior to attempting to add new records you must open the recordset
object you created. Before you can add values to a record you have to create
that record using rsADO.AddNew. Finally, before your function returns the
recordset you should move the record pointer back to the beginning of the
recordset using rsADO.MoveFirst.

Here's a fixed up example of the code you posted that incorporates the
comments above:

Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As ADODB.Recordset
Dim lngR As Long
Dim lngC As Long
Set rsADO = New ADODB.Recordset
For lngC = 1 To (UBound(argArray, 2) - LBound(argArray, 2) + 1)
rsADO.Fields.Append "Test" & CStr(lngC), adInteger, 0,
adFldUpdatable
Next lngC
rsADO.Open
For lngR = 1 To UBound(argArray, 1)
rsADO.AddNew
For lngC = 1 To UBound(argArray, 2)
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
Next lngR
rsADO.MoveFirst
Set ADOCopyArrayIntoRecordset = rsADO
End Function

--
Rob Bovey, Excel MVP
Application Professionals
http://www.appspro.com/

* Take your Excel development skills to the next level.
* Professional Excel Development
http://www.appspro.com/Books/Books.htm

 

[TroyW]

I modified your original function. This gives a general structure that can
be used. Test1 is a demo sub using your function.

Troy


Sub Test1()
Dim myArray(3, 2) As Variant
Dim rsNew As ADODB.Recordset
Dim lngC As Long

myArray(1, 1) = "hello"
myArray(2, 1) = 2.1
myArray(3, 1) = 3.1
myArray(1, 2) = 1.2
myArray(2, 2) = 2.2
myArray(3, 2) = "Bye"

Set rsNew = ADOCopyArrayIntoRecordset(argArray:=myArray)

rsNew.MoveFirst
While Not rsNew.EOF
For lngC = 1 To rsNew.Fields.Count
MsgBox rsNew.Fields(lngC - 1).Value
rsNew.MoveNext
Next lngC
Wend

MsgBox "Done"
End Sub


Private Function ADOCopyArrayIntoRecordset(argArray As Variant) As
ADODB.Recordset
Dim rsADO As ADODB.Recordset
Dim lngR As Long
Dim lngC As Long

Set rsADO = New ADODB.Recordset

For lngC = 1 To UBound(argArray, 2)
rsADO.Fields.Append "Fld" & lngC, adVariant
Next lngC

rsADO.Open

For lngR = 1 To UBound(argArray, 1)
For lngC = 1 To UBound(argArray, 2)
rsADO.AddNew
rsADO.Fields(lngC - 1).Value = argArray(lngR, lngC)
Next lngC
rsADO.MoveNext
Next lngR

rsADO.MoveFirst
Set ADOCopyArrayIntoRecordset = rsADO
End Function

 

[quartz]

Thanks and regards to all who replied, my code actually works now!

 

[aseel]

i insert filter in my worksheet, and i made to each cell hyperlink the
problem is when i select items from filter appear to me this message (fixed
object will move)