VBA slow reading back from database

[garydp]

I have an Access database that i write to using VBA from an excel spreadsheet.
the spreadsheet has a listview called lstfail loaded with all of the data that is entered into the database.

when data is entered onto the spreadsheet the data is writen to the database without any problem. once the data is saved to the database the listview should update with the latest data from the database. This isnt happening, i am having to close excel and reopen to see the new data. i have even put a time delay in before reading back the data.

this is how im writing to the database

    Set cn = New ADODB.Connection
    dbPath = Application.ActiveWorkbook.Path & "\Touch Sheet.mdb"
    cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & dbPath & ";"
    Set rs = New ADODB.Recordset
    sSQL = "SELECT * From [Failures]"
    rs.Open sSQL, cn, adOpenDynamic, adLockOptimistic
    rs.AddNew
    rs!Date = Format(Now, "dd/mm/yyyy")
    rs!Month = Format(Now, "mmmm")
    rs!CompTime = ""
    rs!Category = cbFCat.Value
    rs!Type = cbFType.Value
    rs!WO = cbFWO.Value
    rs!Serial = txtSerial.Text
    rs!PartNo = cbFPartNo.Value
    rs!TBCode = Left(cbFTBCode.Value, 2)
    rs!TBCodeDesc = Replace(cbFTBCode.Value, Left(cbFTBCode.Value, 4), "")
    rs!Lost = "1"
    rs!Reason = txtReason.Text
    rs!Operator = cbFOperator.Value
    rs!process = cbFProcess.Value
    rs.Update
    rs.Close

this is how loading the listview with the data after writing to the databse

Set cn = New ADODB.Connection
    dbPath = Application.ActiveWorkbook.Path & "\Touch Sheet.mdb"
    cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Data Source=" & dbPath & ";"
    Set rs = New ADODB.Recordset
    sSQL = "SELECT * From [Failures] ORDER BY [WO]"
    rs.Open sSQL, cn, adOpenDynamic, adLockUnspecified
    i = 1
    Do Until rs.EOF
        With frmTouchSheet.lstFail
            .ListItems.Add , , ""
            .ListItems.Item(i).ListSubItems.Add = rs!Date
            .ListItems.Item(i).ListSubItems.Add = rs!Month
            .ListItems.Item(i).ListSubItems.Add = rs!CompTime
            .ListItems.Item(i).ListSubItems.Add = rs!Category
            .ListItems.Item(i).ListSubItems.Add = rs!Type
            .ListItems.Item(i).ListSubItems.Add = rs!WO
            .ListItems.Item(i).ListSubItems.Add = rs!Serial
            .ListItems.Item(i).ListSubItems.Add = rs!PartNo
            .ListItems.Item(i).ListSubItems.Add = rs!TBCode
            .ListItems.Item(i).ListSubItems.Add = rs!TBCodeDesc
            .ListItems.Item(i).ListSubItems.Add = rs!Lost
            .ListItems.Item(i).ListSubItems.Add = rs!Reason
            .ListItems.Item(i).ListSubItems.Add = rs!Operator
            .ForeColor = vbBlack
            .SelectedItem.Selected = False
        End With
        i = i + 1
        rs.MoveNext
    Loop

when the first set of data is entered it is loaded into the listview straight away, form the second set onwards it doesnt load or it loads the first set again.

[Kenneth Hobs]

Be sure to set your connection and record set to nothing. See the end of this example:

'http://www.microsoft.com/downloads/details.aspx?FamilyID=6c050fe3-c795-4b7d-b037-185d0506396c&DisplayLang=en

Option Explicit
'Connection Strings, http://www.connectionstrings.com/


'http://msdn.microsoft.com/en-us/library/ms808325.aspx


Sub ADO()
'   Set Reference in Tools to: Microsoft ActiveX Data Objects 2.x Library
    Dim DBFullName As String
    Dim Cnct As String, Src As String
    Dim Connection As ADODB.Connection
    Dim RecordSet As ADODB.RecordSet
    Dim Col As Integer, Row As Long, s As String
    
'   Database information
    DBFullName = ActiveWorkbook.Path & "\NWind2003.mdb"
'Exit?
    If Dir(DBFullName) = "" Then Exit Sub


'Clear any existing data from activesheet
   Cells.Clear


'   Open the connection
    Set Connection = New ADODB.Connection
    Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
    Cnct = Cnct & "Data Source=" & DBFullName & ";"
    Connection.Open ConnectionString:=Cnct
    
'   Create RecordSet
    Set RecordSet = New ADODB.RecordSet
'   Record locking
  RecordSet.CursorType = adOpenKeyset
  RecordSet.LockType = adLockOptimistic
    
    With RecordSet
'       Filter
        'Src = "SELECT * FROM Products WHERE ProductName = 'Watch' "
        'Src = Src & "and CategoryID = 30"
        Src = "SELECT Orders.CustomerID, Orders.OrderDate " & _
          "FROM Orders " & _
          "WHERE (((Orders.OrderDate) " & _
          "Between #8/1/1994# and #8/30/1994#))"
        RecordSet.Open Source:=Src, ActiveConnection:=Connection


'       Write the field names
        For Col = 0 To .Fields.Count - 1
           Range("A1").Offset(0, Col).Value = RecordSet.Fields(Col).Name
        Next Col
        
'       Write the recordset
        Range("A1").Offset(1, 0).CopyFromRecordset RecordSet
        Dim a As Variant
        .MoveFirst
        a = RecordSet.GetRows
        MsgBox LBound(a), , UBound(a)
        MsgBox a(0), , a(1)


        If .RecordCount < 1 Then GoTo endnow
        .MoveFirst
        For Row = 0 To (.RecordCount - 1)
          'Debug.Print CStr(.Fields(Row).Value)
          .MoveNext
        Next Row
  End With
endnow:
    Set RecordSet = Nothing
    Connection.Close
    Set Connection = Nothing
End Sub

[Aflatoon]

You don't appear to be clearing the Listview.Listitems anywhere, so you are adding the new data after the previous data set.

[jonh]

Close the connection. Maybe something is holding it open.

Also, you probably don't need dynamic cursors.

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Private Sub Command0_Click()

    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\test.accdb;"
    
    cn.Open

        rs.Open "SELECT * From table1", cn, adOpenStatic, adLockOptimistic

            rs.AddNew
                rs!a = Day(Date)
                rs!b = Month(Date)
                rs!c = Year(Date)
            rs.Update
        rs.Close
    cn.Close
    
    rsout
End Sub

Sub rsout()
    cn.Open

        rs.Open "select * from table1", cn, adOpenForwardOnly, adLockReadOnly

            Do Until rs.EOF

                'print out
                Debug.Print rs(0).Value, rs(1).Value, rs(2).Value, rs(3).Value

                rs.MoveNext
            Loop
        rs.Close
    cn.Close
End Sub