Using copyfromrecordset (database to excel)

I am linking SPSS database to excel by using ADO. It works well but I am not able to write the results of the recordset to the spreadsheet by using copyfromrecordset. The recordset is getting populated correctly, but "copyfromrecordset" doesnt seem to be working.  

I have pasted my code below.

Thanks for any help.

Code:


Option Explicit
Dim recarray As Variant

Public gcnFunction As ADODB.Connection


Public cnConn As ADODB.Connection

Public strConn As String


Private Function DbConnect(Optional strDataSource As String) As Boolean
    DbConnect = True
    On Error GoTo ERROR_FUNCTION
'    If strDataSource = EMPTY_STRING Then
'        strDataSource = ThisWorkbook.FullName
'    End If
Dim sPath As String

sPath = "C:\Documents and Settings\momer\Desktop\ESAT Rebuild"
    strConn = "Provider=MSDASQL.1;Persist Security Info=False;" _
                        & "Extended Properties=""DRIVER={SPSS 32-BIT Data Driver (*.sav)};DBQ=" _
                        & sPath & ";SERVER=NotTheServer"""
    Select Case True
        Case cnConn Is Nothing
            Set cnConn = New ADODB.Connection
            cnConn.Open strConn
        Case cnConn.State = adStateClosed
            cnConn.Open strConn
    End Select
EXIT_FUNCTION:
    Exit Function
ERROR_FUNCTION:
    DbConnect = False
    Debug.Print "Error DbConnect: " & Err.Description
    Err.Clear
    GoTo EXIT_FUNCTION
End Function


Public Sub connect()

Dim strsql As String


strsql = "SELECT COUNT(*) from import1 GROUP BY status"

Dim sp As String

sp = "C:\Documents and Settings\rt\Desktop\Rebuild"


Set gcnFunction = New ADODB.Connection
'
Dim rsCount As ADODB.Recordset

    If GetRecordset(strsql, rsCount) Then
   
    End If

Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("A1").CopyFromRecordset rsCount 'Not writing to spreadsheet
End Sub

Public Function GetRecordset(ByVal strsql As String, ByRef rsRec As ADODB.Recordset) As Boolean
    GetRecordset = True
    On Error GoTo ERROR_FUNCTION
    Set rsRec = New ADODB.Recordset
    If Not DbConnect() Then GoTo ERROR_FUNCTION
    rsRec.Open strsql, cnConn, adOpenStatic, adLockOptimistic
   
    recarray = rsRec.GetRows
   
  MsgBox recarray(0, 0) & ", " & recarray(0, 1)

    Worksheets("Sheet2").Range("A1").CopyFromRecordset rsRec 'Not writing to spreadsheet
EXIT_FUNCTION:
    Exit Function
ERROR_FUNCTION:
    Debug.Print Err.Number & " : " & Err.Description
    Debug.Print strsql
    Err.Clear
    GetRecordset = False
    GoTo EXIT_FUNCTION
End Function
momer123Asked:
Who is Participating?
 
Kelvin81Connect With a Mentor Commented:
no worries... I'm glad we got it working
0
 
Kelvin81Commented:
Take the worksheets("Sheet2").... etc out of the getrecordset if you don't need it there.... and you say it doesn't throw an error...

have you manually verified the data in the recordset in the immediate window?
0
 
momer123Author Commented:
Yes it doesnt throw any error.

For verifying the data, I copies the content of recordset into a variant array-

recarray = rsRec.GetRows

recarray shows the correct values when I checked it through messagebox and immediate window.

Thanks.

0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Kelvin81Commented:
try this

?rsCount(0)


also, don't declare another string sql... its one of your global variables..its screwing around with things a bit.
0
 
momer123Author Commented:
Running ?rscount(0) throws up an error- Run time error 3021- "either BOF or EOF is true or the current record has been deleted. Requested operation requires a current record".

I get the same error when I run rsRec(0) when the control is in getRecordSet function.

0
 
Kelvin81Commented:
that means that there are no records in the recordset.

try taking out the line:

Dim strsql As String
0
 
Kelvin81Commented:
(When you have either the beginning OR the end Or the recordset has been deleted..... nothing can be found there)

0
 
momer123Author Commented:
Still doesnt work. Hmm. its wierd that it throws that error 3021 (that the recordset is empty) and at the same time copying into variant array works and the array shows the values.
0
 
Kelvin81Commented:
OK:

I tested this out.  I created an access database.. populated it with some data... and ran your sub. It spit out for me everything it was supposed to.  I made a few minor changes... try to run this, if you have a problem with this, double check your connection string.  

Option Explicit
Dim recarray As Variant
Public cnConn As ADODB.Connection
Public strConn As String


Private Function DbConnect(Optional strDataSource As String) As Boolean
    DbConnect = True
    On Error GoTo ERROR_FUNCTION
'    If strDataSource = EMPTY_STRING Then
'        strDataSource = ThisWorkbook.FullName
'    End If
Dim sPath As String

sPath = "F:\Test"
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & sPath & "\localtest.mdb;"
    Select Case True
        Case cnConn Is Nothing
            Set cnConn = New ADODB.Connection
            cnConn.Open strConn
        Case cnConn.State = adStateClosed
            cnConn.Open strConn
    End Select
EXIT_FUNCTION:
    Exit Function
ERROR_FUNCTION:
    DbConnect = False
    Debug.Print "Error DbConnect: " & Err.Description
    Err.Clear
    GoTo EXIT_FUNCTION
End Function


Public Sub connect()
Dim rsCount As ADODB.Recordset

    strsql = "SELECT COUNT(*) from import1 GROUP BY status"
    If GetRecordset(strsql, rsCount) Then
    End If
    Worksheets("Sheet2").Range("A1").CopyFromRecordset rsCount 'Not writing to spreadsheet
End Sub

Public Function GetRecordset(ByVal strsql As String, ByRef rsRec As ADODB.Recordset) As Boolean
    GetRecordset = True
    On Error GoTo ERROR_FUNCTION
    Set rsRec = New ADODB.Recordset
    If Not DbConnect() Then GoTo ERROR_FUNCTION
    rsRec.Open strsql, cnConn, adOpenStatic, adLockOptimistic
EXIT_FUNCTION:
    Exit Function
ERROR_FUNCTION:
    Debug.Print Err.Number & " : " & Err.Description
    Debug.Print strsql
    Err.Clear
    GetRecordset = False
    GoTo EXIT_FUNCTION
End Function

0
 
momer123Author Commented:
I never thought this could be a problem-

recarray = rsRec.GetRows

I had declared recarray as a variant and if I comment the above line of code in my original code, CopyFromRecordset works. May be the above statement is emptying the contents of rsRec when copying to recarray.

Thanks for looking into this.





0
All Courses

From novice to tech pro — start learning today.