asked on

Excel2003-VBA-ADODB How do I store a recordset in memory?

I want to read data into a recordset, close the connection to source, and use the snapshot from memory. The data never gets written back, it is read only and not particulary dynamic.

I would like to stay with the recordset type as my current code is built around it and I use the recordset.filter to retrieve data for populating cells.

here's my code

    Dim Rst As ADODB.Recordset
    Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection

    With cn
        .Provider = "MSDASQL"
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ= myfile.xls; ReadOnly=False;"
        .Open
    End With


    Dim strQuery As String
    strQuery = "SELECT * FROM DATA WHERE [FTN] > 0"
    Set Rst = cn.Execute(strQuery)

 '* DO STUFF
   
    cn.Close
'* RST becomes unavailable when cn is closed

    Set cn = Nothing
    Set Rst = Nothing

Open in new window

I want to clone the recordset and keep it in memory after closing cn.... How do I accomplish this?

Steve

you can use the getrows:

Dim MyRecordset
MyRecordset = Rst.getrows

Open in new window

ASKER CERTIFIED SOLUTION

Rory Archibald

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Grizzler

ASKER

Set Rst.activeconnection = nothing

Error "Operation Not Allowed When The Object Is Open"

Rory Archibald

Forgot to mention you need to use a client side cursor:

rst.cursorlocation = aduseclient

Open in new window

Grizzler

ASKER

The_Barman method yields 2 dimensional array... I am trying to avoid this if possible, personal preference.

This yields "Operation Not Allowed While The Object Is Open"

Set Rst = cn.Execute(strQuery)
rst.cursorlocation = aduseclient

Open in new window

If I do the following, I believe the parameter settting goes away. And I get the error on the other end trying to set active connection to nothing. Perhaps I need a different method of poulating rst that allows the clientcursor setting?

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Set Rst = cn.Execute(strQuery)

Open in new window

Rory Archibald

The second method is the correct order. Can you post the full code you have?

Grizzler

ASKER

Sub LoadRecordset2()
    Dim startTime As Date
    startTime = Now
    Application.Cursor = xlWait
    Dim upCount As Integer
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim WBName As String
    WBName = wb.FullName



    Dim Rst As ADODB.Recordset
    Dim cn As ADODB.Connection
    
    Set cn = New ADODB.Connection
    Set Rst = New ADODB.Recordset
    Rst.CursorLocation = adUseClient
    

    With cn
        .Provider = "MSDASQL"
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ= catalog.xls; ReadOnly=True;"
        .Open
    End With

    Dim lastFtn As String


    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
    ' makes sure that the statusbar is visible
    Application.StatusBar = "Loading Current Tool Data Into Memory....."

    Dim strQuery As String
    strQuery = "SELECT * FROM DATA WHERE [FTN] > 0"

    Set Rst = cn.Execute(strQuery)

    Rst.MoveFirst
    Rst.MoveNext
    Rst.MoveFirst


    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim colAlias As String
    Dim colSrc As String
    Dim SheetStyle As Integer

    SheetStyle = 1
    If Left(WBName, 1) = "G" Or Left(WBName, 11) = "\\shop\code" And UCase(wb.Name) <> UCase("FTN Catalog.XLS") Then
        For Each ws In wb.Worksheets


            ' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            ' X````````````````````````````````````````````````````````````````````````````````````````````````````````X
            ' X NEED TO CHECK SHEET TYPE HERE AND SET SHEET STYLE                                                      X
            ' X........................................................................................................X
            ' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX



            If InStr(UCase$(ws.Name), "TOOLS") Then
                stylesheet = getstyle(ws)
                If stylesheet <> 0 Then

                    For i = 14 To 100
                        For col = 1 To 5
                            Select Case col * SheetStyle

                                'sheetStyle=1
                            Case 1
                                colAlias = "Q"
                                colSrc = "LOC"
                            Case 2
                                colAlias = "T"
                                colSrc = "OOH"
                            Case 3
                                colAlias = "W"
                                colSrc = "DESC"
                            Case 4
                                colAlias = "AK"
                                colSrc = "HOLDER"
                            Case 5
                                colAlias = "BB"
                                colSrc = "CRIB"

                                'sheetStyle=10
                            Case 10
                                colAlias = "Q"
                                colSrc = "$D:$D"
                            Case 20
                                colAlias = "T"
                                colSrc = "$D:$D"
                            Case 30
                                colAlias = "W"
                                colSrc = "$D:$D"
                            Case 40
                                colAlias = "AO"
                                colSrc = "$D:$D"
                            End Select
                            With ws.Range(colAlias & i)
                                If ws.Range("E" & i).MergeCells And ws.Range("E" & i) <> "" Then
                                    Rst.Filter = "[FTN] = '" & ws.Range("E" & i) & "'"
                                    If Not (Rst.BOF And Rst.EOF) Then
                                        .Value = Rst(colSrc)
                                    Else
                                        If colSrc <> "DESC" Then .Value = "-----" Else .Value = "TOOL " & ws.Range("E" & i) & " NOT FOUND"
                                    End If
                                    Application.StatusBar = "Updating Sheet " & ws.Name & "  " & String(i - 10, ChrW(9609))
                                    upCount = upCount + 1
                                Else
                                    .Value = ""
                                End If

                            End With

                        Next col
                    Next i
                End If
            End If
        Next ws
    End If
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Rst.Filter = ""
    Rst.ActiveConnection = Nothing

    cn.Close


    Set cn = Nothing
    Set Rst = Nothing

    Application.Cursor = xlDefault
    MsgBox upCount & " Updates In " & DateDiff("s", startTime, Now) & " seconds.", , "MacKay IT"
End Sub

Open in new window

Grizzler

ASKER

changed

'Set Rst = cn.Execute(strQuery)

Open in new window

Rst.Open strQuery, cn

Open in new window

Works , and its faster... alot faster

Grizzler

ASKER

Rst declared as global

Final Code Portion:

    Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection
    Set Rst = New ADODB.Recordset
    Rst.CursorLocation = adUseClient
   
    With cn
        .Provider = "MSDASQL"
        .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};DBQ= MyFile.xls; ReadOnly=False;"
        .Open
    End With

    Dim strQuery As String
    strQuery = "SELECT * FROM DATA WHERE [FTN] > 0"

    Rst.Open strQuery, cn
    Rst.ActiveConnection = Nothing

    cn.Close
    Set cn = Nothing

*DO stuff with disconnected RST...WooHoo!!!

Open in new window

Grizzler

ASKER

Exactly what I wanted!