Problem with ADODB.Recordset

[gbat]

Hi

I have a problem using an ADOBD.recordset to query data held in SQL Server -when I connect to a SQL server database hosted locally on one of my company's servers I have no problem but the test database I need to use for our UAT is hosted on a remote server at one of our software suppliers which I connect to using the IP address. My code is as follows (I have edited the connection string for data protection purposes) :-

Public Function GetBusinessTypesFromCMS() As Variant
    ' This function returns all the business types in CMS applicable to this BU
    ' Declare local variables
    Dim liBusinessTypes() As Integer
    Dim lsSQL As String
    Dim lsParentCompany As String
    Dim lsBusinessUnit As String
    Dim adoConnection As New ADODB.Connection
    Dim adoRecordset As New ADODB.recordset
    Dim liCounter As Integer
    
On Error GoTo ErrorHandler
    


    lsParentCompany = GetParameterValue("ParentCompany")
    lsBusinessUnit = GetParameterValue("BUSINESS_UNIT")

    ReDim liBusinessTypes(99) ' Set to 99 as a max - we redim it later

'    ' We can create the connection again as the connection pooling capabilites on the
'    ' sql server will reallocate our previous connection and is better for performance
'    adoConnection.ConnectionString = "DRIVER={SQL Server};SERVER=" & _
'        GetParameterValue("CMSServerName") & ";UID=" & GetParameterValue("CMSUID") & _
'        ";PASSWORD=" & GetParameterValue("CMSPassword") & ";DATABASE=" & GetParameterValue("CMSDatabase")

    adoConnection.ConnectionString = "Provider=sqloledb;Data Source=111.111.11.111,1566;Network Library=DBMSSOCN;Initial Catalog=xxxxx;User ID=xxxx;Password=xxx;"
    adoConnection.Open


    lsSQL = "SELECT BUSINESS_TYPE_ID FROM T_BUSINESS_TYPE " & _
            "WHERE DESCRIPTION IN (SELECT BUSINESS_TYPE_DESCRIPTION FROM T_JLT_UNIT_BUSINESS_TYPES " & _
            "WHERE JLT_COMPANY = '" & lsParentCompany & "' AND " & _
            "BUSINESS_UNIT = '" & lsBusinessUnit & "')"

    adoRecordset.Open lsSQL, adoConnection, adOpenStatic, adLockReadOnly

    If adoRecordset.RecordCount > 0 Then
        ' Re dimension the array
        ReDim liBusinessTypes(adoRecordset.RecordCount - 1)
    Else
        ' Haven't got anything - exit function
        GetBusinessTypesFromCMS = Null
        Exit Function
    End If

    liCounter = 0

    Do While Not adoRecordset.EOF
        liBusinessTypes(liCounter) = adoRecordset.Fields("BUSINESS_TYPE_ID")
        liCounter = liCounter + 1
        adoRecordset.MoveNext
    Loop

    adoRecordset.Close
    Set adoRecordset = Nothing
    adoConnection.Close
    Set adoConnection = Nothing

    GetBusinessTypesFromCMS = liBusinessTypes()
    Exit Function

ErrorHandler:
    GetBusinessTypesFromCMS = Null
    WriteToErrorLog Err.Number, Left(Err.Description, 255), "GetBusinessTypesFromCMS"
    If Not IsNull(adoRecordset) Then
        adoRecordset.Close
        Set adoRecordset = Nothing
    End If
    If Not IsNull(adoConnection) Then
        Set adoConnection = Nothing
    End If
    
    Exit Function
    
End Function

The error happens when I try and .MoveNext through the recordset and I get a memory error at "0x753cb8d5" - The memory could not be read. Clicking ok then causes Access to shut down. On the local connection it works fine.

I am using Access 2000 and connecting to SQL Server 2000.

any ideas?

thanks

 

[gbat]

For anyone who's interested

Still haven't worked out what the actual problem was (I suspect it might me be a setting on the remote SQL Server) but I have managed to get round it using the following code I found elsewhere - basically the original returned recordset is streamed out as xml and then read back into to a different recordset. Seems to work fine

Public Function GetBusinessTypesFromCMS() As Variant
    ' This function returns all the business types in CMS applicable to this BU
    ' Issues were encountered when running this code over IP to a SQL server so
    ' now we will copy the returned recordset into an XML stream and use that to
    ' clone the data - this seems to get round the problem
    ' Declare local variables
    Dim liBusinessTypes() As Integer
    Dim lsSQL As String
    Dim lsParentCompany As String
    Dim lsBusinessUnit As String
    Dim adoConnection As New ADODB.Connection
    Dim adoRecordset As New ADODB.recordset
    Dim adoRstClone As ADODB.recordset
    Dim lstmXml As ADODB.Stream
    Dim liCounter As Integer

On Error GoTo ErrorHandler



    lsParentCompany = GetParameterValue("ParentCompany")
    lsBusinessUnit = GetParameterValue("BUSINESS_UNIT")

    ReDim liBusinessTypes(99) ' Set to 99 as a max - we redim it later

'    ' We can create the connection again as the connection pooling capabilites on the
'    ' sql server will reallocate our previous connection and is better for performance
'    adoConnection.ConnectionString = "DRIVER={SQL Server};SERVER=" & _
'        GetParameterValue("CMSServerName") & ";UID=" & GetParameterValue("CMSUID") & _
'        ";PASSWORD=" & GetParameterValue("CMSPassword") & ";DATABASE=" & GetParameterValue("CMSDatabase")
'
    adoConnection.ConnectionString = "Provider=sqloledb;Data Source=xxxxxxxxx,xxxx;Network Library=DBMSSOCN;Initial Catalog=xxxxxx;User ID=xxxxxx;Password=xxx;"
    adoConnection.Open


    lsSQL = "SELECT BUSINESS_TYPE_ID FROM T_BUSINESS_TYPE " & _
            "WHERE DESCRIPTION IN (SELECT BUSINESS_TYPE_DESCRIPTION FROM T_JLT_UNIT_BUSINESS_TYPES " & _
            "WHERE JLT_COMPANY = '" & lsParentCompany & "' AND " & _
            "BUSINESS_UNIT = '" & lsBusinessUnit & "')"

    adoRecordset.CursorLocation = adUseClient
    adoRecordset.Open lsSQL, adoConnection, adOpenStatic, adLockBatchOptimistic

    ' save recordset into ADO stream
    Set lstmXml = New ADODB.Stream
    lstmXml.Open
    adoRecordset.Save lstmXml, adPersistXML

    ' now clone the data
    Set adoRstClone = New ADODB.recordset
    adoRstClone.Open lstmXml

    ' close the stream
    lstmXml.Close
    Set lstmtxml = Nothing

    If adoRstClone.RecordCount > 0 Then
        ' Re dimension the array
        ReDim liBusinessTypes(adoRstClone.RecordCount - 1)
    Else
        ' Haven't got anything - exit function
        GetBusinessTypesFromCMS = Null
        Exit Function
    End If

    liCounter = 0

    Do While Not adoRstClone.EOF
        liBusinessTypes(liCounter) = adoRstClone.Fields("BUSINESS_TYPE_ID")
        liCounter = liCounter + 1
        adoRstClone.MoveNext
    Loop

    adoRstClone.Close
    Set adoRstClone = Nothing
    adoRecordset.Close
    Set adoRecordset = Nothing
    adoConnection.Close
    Set adoConnection = Nothing

    GetBusinessTypesFromCMS = liBusinessTypes()
    Exit Function

ErrorHandler:
    GetBusinessTypesFromCMS = Null
    WriteToErrorLog Err.Number, Left(Err.Description, 255), "GetBusinessTypesFromCMS"
    If Not IsNull(adoRecordset) Then
        adoRecordset.Close
        Set adoRecordset = Nothing
    End If
    If Not IsNull(adoRstClone) Then
        adoRstClone.Close
        Set adoRstClone = Nothing
    End If
    If Not IsNull(lstmXml) Then
        lstmXml.Close
        Set lstxml = Nothing
    End If
    If Not IsNull(adoConnection) Then
        Set adoConnection = Nothing
    End If

    Exit Function

End Function