Keskustelu: Ohjelmointikysymykset: VBA listboxiin dataa, mutta miten vain ajallisesti viimeisin

'VBA-Projektiin referenssi: Microsoft DAO 3.6 Object Library
'UserForm1:
'1 ListBox (ListBox1)
'1 Tekstiruutu (TextBox1)
'1 Komentopainike (CommandButton1)

Private engine As DAO.DBEngine
Private db As DAO.Database
Private rs As DAO.Recordset

Private Sub UserForm_Activate()

    Static IsLoaded As Boolean

    If Not IsLoaded Then

        Set engine = New DBEngine
        On Error Resume Next
        Set db = engine.Workspaces(0).OpenDatabase("C:\Tietokanta1.mdb", _
        False, False, "MS Access;PWD=") 'esim.

        If Err <> 0 Then
           MsgBox Error$
           Err.Clear
           On Error Goto 0
           CommandButton1.Enabled = False
           Exit Sub
        End If

        IsLoaded = True

    End If

End Sub

Private Sub CommandButton1_Click()

    If TextBox1.Text = "" Then
        TextBox1.SetFocus
        Exit Sub
    End If

    On Error GoTo ErrorHandler
    Set rs = db.OpenRecordset("SELECT TUOTE, PVM FROM Taulu1 WHERE TUOTE='" & _
    TextBox1.Text & "' ORDER BY PVM ASC", dbOpenDynaset, dbOptimistic, dbReadOnly) 'esim.

    If rs.RecordCount > 0 Then
        'ListBox1.Clear
        rs.MoveLast
        ListBox1.AddItem rs!TUOTE & " " & rs!PVM
    End If

    rs.Close: Set rs = Nothing
    Exit Sub

ErrorHandler:

    MsgBox Error$
    Err.Clear
    On Error GoTo 0

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

        On Error Resume Next
        db.Close: Set db = Nothing
        Set engine = Nothing

End Sub

'VBA-Projektiin referenssi: Microsoft ActiveX Data Objects 2.8 Library  (msado15.dll)

'UserForm1:
'1 ListBox (ListBox1)
'1 Tekstiruutu (TextBox1)
'1 Komentopainike (CommandButton1)

Private cn As ADODB.Connection
Private rs As ADODB.Recordset
Private IsOpen As Boolean

Private Sub UserForm_Activate()

    If Not IsOpen Then

        Set cn = New ADODB.Connection
        On Error Resume Next
        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Tietokanta1.mdb;"

        If Err <> 0 Then
            MsgBox Error$
            Err.Clear
            On Error GoTo 0
            CommandButton1.Enabled = False
        Else
            IsOpen = True
        End If

    End If

End Sub

Private Sub CommandButton1_Click()

    If TextBox1.Text = "" Then
        TextBox1.SetFocus
        Exit Sub
    End If

    Set rs = New ADODB.Recordset
    On Error Resume Next
    rs.Open "SELECT TUOTE, PVM FROM Taulu1 WHERE TUOTE='" & TextBox1.Text _
    & "' ORDER BY PVM ASC", cn, adOpenStatic, adLockOptimistic, -1 'esim.

    If Err <> 0 Then

        MsgBox Error$
        Err.Clear
        On Error GoTo 0
        Set rs = Nothing
        Exit Sub

    End If

    If rs.RecordCount > 0 Then
        'ListBox1.Clear
        rs.MoveLast
        ListBox1.AddItem rs!TUOTE & "  " & rs!PVM
    End If

    rs.Close: Set rs = Nothing

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    cn.Close: Set cn = Nothing

End Sub