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

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
        .Rows = rsDMI.RecordCount + 1
        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")
            .Row = intRecordCounter
            .Col = 0
            .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

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

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