CODEWITHSUNDEEP
excelvba
percydeveloper
percydeveloper

Reputation: 49

Function returning a recordset

I have wrote 2 functions, in one function I am creating a sql statement and sending it to another function where I run the query and return the record set.

The problem is that when I return the record set and try to set it, it's not working.

Function DB_Exp(ByVal sht, range_IDent)

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
MoveCursor = False


Dim MyData As String, strData() As String, TmpAr() As String
Dim TwoDArray() As String
Dim i As Long, n As Long
Dim rs As ADODB.Recordset

FilePath = Sheets("dbs").Cells(12, "J") & "Log.csv"

Open FilePath For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)

For i = LBound(strData) To UBound(strData)
If Len(Trim(strData(i))) <> 0 Then
    TmpAr = Split(strData(i), Delim)
    num_str = UBound(TmpAr, 1)
    countString = "Select count(*) from [Checking].[dbo].[Data]"

    Set rs = ADOExcelSQLServer(countString)

    Debug.Print rs.RecordCount 'Getting Error Here

    If rs.EOF And rs.BOF Then
    Else
        Do While Not rs.EOF
            For j = 0 To rs.Fields.Count - 1
                Debug.Print rs.Fields(j).Value
            Next j
            rs.MoveNext
        Loop
    End If
    n = n + 1
    ReDim Preserve TwoDArray(1, 1 To n)
    '~~> TmpAr(1) : 1 for Col B, 0 would be A
    TwoDArray(1, n) = TmpAr(2)
End If
Next i
End Function

Function ADOExcelSQLServer(sStr) As ADODB.Recordset

Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Set rs = New ADODB.Recordset

Server_Name = "" ' Enter your server name here
Database_Name = "" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here

Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open sStr, Cn, adOpenStatic

If rs.EOF And rs.BOF Then
    Set ADOExcelSQLServer = Null
Else
    Set ADOExcelSQLServer = rs
End If

Cn.Close
Set Cn = Nothing
End Function

I am getting an error at Debug.Print rs.RecordCount 'Getting Error Here

Upvotes: 1

Views: 441

Answers (1)

Parfait
Parfait

Reputation: 107767

Error occurs because you are closing the connection object in the function, effectively also closing open recordsets even if it follows the function return line. Simply remove the Cn.Close line.

If rs.EOF And rs.BOF Then
    Set ADOExcelSQLServer = Null
Else
    Set ADOExcelSQLServer = rs
End If

'Cn.Close                                <---- REMOVE 
Set Cn = Nothing

Upvotes: 1

Related Questions