ADO Recordset - Data Grid Results Update - Blank Grid

[h4fod]

Hi
I have successfully coded a sample application using VB6 for my students using two ADO recordsets. It is a straightforward 'Stock Management' context. The recordsets link to two respective MS Access 97 tables ('tblStock' and 'tblStockAudit' using JET 3.5. Iteratively, the fields in the Stock Table (tblStock) are read using the 'Fields' property and if the current stock level < minStockLevel for each db record then a new record is added to the 'tblStockAudit' Access table, flushed prior to the algorithm commencing. The algorithm works fine. Correctly, populating records meeting this criteria ARE added to the tblStockAudit table in access and '10 records added' are reported using the sample data.

However when the recordset rsStockShortages is set as the datasource to the DataGrid object and is refreshed the grid is blank! I think there must be a simple solution. Have I overlooked something here. (Some variables may be superflous in the liting - still work in progress!)
Many thanks in anticipation.

Private Sub cmdStockLevels_Click()
'Dimension Local variables
Dim intNumberInStock As Integer
Dim strStockID As String
Dim sngStockPrice As Single
Dim intMinReOrderQty As Integer
Dim intQtyInStock As Integer
Dim intShortage As Integer
Dim intSupplier As String
Dim sngStockValueTotal As Single
Dim sngStockValeRunningTotal As Single
Dim intCount As Integer

'Connection to MS Access database common to both ADODB recordsets
Set conn = New ADODB.Connection

'Establish two recordsets connected via this connection to GreenparksSchool.mdb
Set rsStock = New ADODB.Recordset
Set rsStockShortages = New ADODB.Recordset


conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source= " & "C:\temp\GreenparksSchool.mdb" & " ;Persist Security Info = false"
conn.Open

'Open both recordsets
rsStock.Open ("SELECT * FROM tblStock"), conn, adOpenStatic, adLockReadOnly
rsStockShortages.Open ("SELECT * FROM tblStockAudit"), conn, adOpenStatic, adLockOptimistic

'Clear any records which currently exist in the Stock Audit database
'table
'THIS CODE DOES NOT WORK _ CHECK METHODS FOR ADO
        Do While Not rsStockShortages.EOF
            rsStockShortages.Delete
            rsStockShortages.MoveNext
        Loop
        
With rsStock

i = 1

        Do While Not .EOF
            intStockID = .Fields![Stock_ID].Value
            strStockDescription = .Fields![Description]
            sngStockPrice = .Fields![Price].Value
            intQtyInStock = .Fields![Qty_In_Stock].Value
            intMinReOrderQty = .Fields![Qty_Min_ReOrder].Value
            strSupplier = .Fields![Supplier].Value
            intMinStockLevel = .Fields![Qty_MinStockLevel].Value

                    If intQtyInStock <= intMinStockLevel Then
                        'Now add a new Shortages record to the rsShortagesRecordset
                            With rsStockShortages
                                .AddNew
                                    .Fields![ShortageID].Value = intStockID
                                    .Fields![Description].Value = strStockDescription
                                    .Fields![Price] = sngStockPrice
                                    .Fields![Qty_MinStockLevel] = intMinStockLevel
                                    .Fields![Supplier] = strSupplier
                                    .Fields![MinReOrderQty] = intMinReOrderQty
                                    .Fields![QuantityInStock] = intQtyInStock
                                    .Fields![AuditDate] = Date
                                .Update
                            
                            End With
                            
                            
                            
                            
                            
                            
                    End If
                    i = i + 1
            .MoveNext
        Loop
'Fields (0)
'Fields ("name")
'Fields![name]
End With

'Count Shortages
rsStockShortages.MoveLast
rsStockShortages.MoveFirst
intCount = rsStockShortages.RecordCount
lbluserMessage.Caption = intCount & " shortages have been recorded and need to be ordered " & _
    "from our suppliers"
    
'Display in Grid
Set DataGrid1.DataSource = rsStockShortages
DataGrid1.Refresh

'Close both recordsets
rsStock.Close
rsStockShortages.Close
conn.Close

Set conn = Nothing
End Sub

 

[genomon]

This may not work in your situation but here is code that I wrote for one of my apps. Sorry don't have more time to elaborate right now:

Public Sub RefreshItemGrid()

On Error GoTo GridError

    Dim strTotal As String
    Dim strQuantity As String
    Dim strPrice As String
    Dim intRecordCounter As Integer

    Set rsDMI = New ADODB.Recordset

    OpenADO
    flxItem.Clear
    flxItem.FormatString = "^Item                                                   |^            Price|" & _
        "^  Qty       |^     Total        | "
    strSQL = "SELECT b.product_name, a.ITEM_CD, a.AMOUNT_2, a.RPT_GEN_COPY_CNT, a.AMOUNT FROM tblInvoiceDetail a "
    strSQL = strSQL & "INNER JOIN tblResaleSupplies b ON CInt(a.ITEM_CD) = b.ITEM_CD "
    strSQL = strSQL & "ORDER BY a.ITEM_CD"
    Set rsDMI = New ADODB.Recordset
    With rsDMI
        Set .ActiveConnection = conDMI
        .LockType = adLockOptimistic
        .CursorType = adOpenStatic
        .Source = strSQL
        .Open
        If .EOF And .BOF Then GoTo GridExit
    End With

    rsDMI.MoveFirst
    With flxItem
        [b].Rows = rsDMI.RecordCount + 1 [/b]
        For intRecordCounter = 1 To rsDMI.RecordCount
            strTotal = Format(CSng(rsDMI!AMOUNT) * 0.01, "$####0.00")
            strQuantity = Format(CSng(rsDMI!RPT_GEN_COPY_CNT) * 0.1, "##0.0")
            strPrice = Format(CSng(rsDMI!AMOUNT_2) * 0.01, "$####0.00")
            [b].Row = intRecordCounter
            .Col = 0[/b]
            .Text = rsDMI!product_name
            .Col = 1
            .Text = strPrice
            .Col = 2
            .Text = strQuantity
            .Col = 3
            .Text = strTotal
            .Col = 4
            .Text = rsDMI!ITEM_CD
            rsDMI.MoveNext
        Next intRecordCounter
    End With

GridExit:
    rsDMI.Close
    CloseADO
    Set rsDMI = Nothing
    Exit Sub
    
GridError:
    MsgBox "Item Grid Fill Error " & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Unable to fill item grid"
    Resume GridExit

End Sub

Gluais faicilleach le cupan làn

 

[h4fod]

Hi
Thanks for your reply. There are strong similarities between approaches. In particular we both close the recordet object and connection objects. Question is, when the rs object is closed, does the grid retain the data in the recordset prior to closure (is it cached in some way - data persistance?). Maybe this is why my grid goes blank. If I instigate an Exit sub bypassing ADO conn and rsClosures data is retained??
Hope you can throw some light on this when you have time.

 

[CP60]

1. Make sure the recordset object isn't out of scope

2. Change adOpenStatic to adOpenKeyset

The second possible solution looks like where the problem may be here...

 

[h4fod]

Thank you for resply. have noted point '2' in my coding. Can you advise how I can ensure (declare) objects of this type so they are never 'out of scope'.
many thanks again

 

[CP60]

Well, in order to use it with the data grid, you are going to have to declare the recordset in the top declarations section of the form's code window.

 

[MazeWorX]

Not that i wanted to add anything that CP hasn't already but i noted it was an example for your students and trying too read the code was driving me nuts so ... reformatted

Private Sub cmdStockLevels_Click()
'Dimension Local variables
    Dim intNumberInStock As Integer
    Dim strStockID As String
    Dim sngStockPrice As Single
    Dim intMinReOrderQty As Integer
    Dim intQtyInStock As Integer
    Dim intShortage As Integer
    Dim intSupplier As String
    Dim sngStockValueTotal As Single
    Dim sngStockValeRunningTotal As Single
    Dim intCount As Integer

    'Connection to MS Access database common to both ADODB recordsets
    Set conn = New ADODB.Connection

    'Establish two recordsets connected via this connection to GreenparksSchool.mdb
    Set rsStock = New ADODB.Recordset
    Set rsStockShortages = New ADODB.Recordset

    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source= " & "C:\temp\GreenparksSchool.mdb" & " ;Persist Security Info = false"
    conn.Open

    'Open both recordsets
    rsStock.Open ("SELECT * FROM tblStock"), conn, adOpenStatic, adLockReadOnly
    rsStockShortages.Open ("SELECT * FROM tblStockAudit"), conn, adOpenStatic, adLockOptimistic

    'Clear any records which currently exist in the Stock Audit database
    'table
    'THIS CODE DOES NOT WORK _ CHECK METHODS FOR ADO
    Do While Not rsStockShortages.EOF
        rsStockShortages.Delete
        rsStockShortages.MoveNext
    Loop
    With rsStock
        i = 1
        Do While Not .EOF
            intStockID = .Fields![Stock_ID].Value
            strStockDescription = .Fields![Description]
            sngStockPrice = .Fields![Price].Value
            intQtyInStock = .Fields![Qty_In_Stock].Value
            intMinReOrderQty = .Fields![Qty_Min_ReOrder].Value
            strSupplier = .Fields![Supplier].Value
            intMinStockLevel = .Fields![Qty_MinStockLevel].Value

            If intQtyInStock <= intMinStockLevel Then
                'Now add a new Shortages record to the rsShortagesRecordset
                With rsStockShortages
                    .AddNew
                    .Fields![ShortageID].Value = intStockID
                    .Fields![Description].Value = strStockDescription
                    .Fields![Price] = sngStockPrice
                    .Fields![Qty_MinStockLevel] = intMinStockLevel
                    .Fields![Supplier] = strSupplier
                    .Fields![MinReOrderQty] = intMinReOrderQty
                    .Fields![QuantityInStock] = intQtyInStock
                    .Fields![AuditDate] = Date
                    .Update
                End With
            End If
            i = i + 1
            .MoveNext
        Loop
    End With

    'Count Shortages
    rsStockShortages.MoveLast
    rsStockShortages.MoveFirst
    intCount = rsStockShortages.RecordCount
    lbluserMessage.Caption = intCount & " shortages have been recorded and need to be ordered " & _
                             "from our suppliers"
    'Display in Grid
    Set DataGrid1.DataSource = rsStockShortages
    DataGrid1.Refresh

    'Close both recordsets
    rsStock.Close
    rsStockShortages.Close
    conn.Close

    Set conn = Nothing
End Sub

also

    'THIS CODE DOES NOT WORK _ CHECK METHODS FOR ADO
    Do While Not rsStockShortages.EOF
        rsStockShortages.Delete
        rsStockShortages.MoveNext
    Loop

your code is trying to delete the rsStockShortages but you would need to delete the individual field contents the way you have coded it i assume you want to delete the table contents so

strSQL = "DELETE tblStockAudit.* FROM tblStockAudit;"

then just execute the SQL

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>

 

[CP60]

>but you would need to delete the individual field contents the way you have coded it

????

No, not so.

Though, it would be better to execute the sql to delete the records prior to opening the recordset, the posted code in the OP would indeed delete all of the records in the DB Table properly, provided they use a Keyset cursor type instead of one with a Static cursor, as I mentioned, which is why the code, "doesn't work" because it leaves the records in the source table, only deleting the records out of the storage of the local recordset static object.