Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0441: ADOX-Library zur Listung, Erzeugen, bzw. Löschen von Tabellen

VB 5/6-Tipp 0441: ADOX-Library zur Listung, Erzeugen, bzw. Löschen von Tabellen

 von Stefan Maag

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [4,26 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------ Anfang Projektdatei ADO_Listview_Datagrid.vbp  ------
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.5 Library' gesetzt werden.
' Es muss ein Verweis auf 'Microsoft ADO Ext. 2.5 for DDL and Security' gesetzt werden.
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (MsComCtl.ocx)' wird benötigt.
' Die Komponente 'Microsoft DataGrid Control 6.0 (OLEDB) (MSDatGrd.ocx)' wird benötigt.

'--- Anfang Formular "Testbereich" alias Testbereich.frm  ---
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: DataGrid "DataGrid1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Listenanzeigesteuerungselement "ListView1"
' Steuerelement: Beschriftungsfeld "Label1"
'###########################################################################
' ADO Zugriff auf Datenbank Access 97 und Darstellung in ListView + DataGrid
'
' peter.k.sauer@web.de  12.2001
'
' einbinden über Projekt ... Verweise....
' Microsoft ActiveX Data Object 2.x Library
' Microsoft ADO Ext. 2.5 for DDL and Security
'
' 1 Form, 1 Listview, 1 Datagrid, 1 Textbox, 1 Label, 2 Commandbutton
'
' verwendet wird die Nordwind.mdb aus Access
'
'############################################################################

Option Explicit

Private CnA As New ADODB.Connection
Private RsA As New ADODB.Recordset

Private Sub Command1_Click()
    
    Dim sSql As String
    Dim li As ListItem
    
    Me.MousePointer = vbHourglass
    
    'SQL-String aufbauen
    sSql = "Select * From Kunden Where Firma Like '" & _
           Trim(Text1.Text) & "%' Order by Firma"
    
    With RsA
        'Recordset bei Wiederholung schliessen
        If .State = adStateOpen Then
            'Recordset abhängen
            Set DataGrid1.DataSource = Nothing
            'schliessen
            .Close
        End If
        .CursorType = adOpenKeyset
        .LockType = adLockPessimistic
        .Open sSql, CnA
        
        If .RecordCount = 0 Then
            MsgBox "nix gefunden"
            .Close
            Me.MousePointer = vbDefault
            Exit Sub
        End If
        .MoveFirst
    End With
    
    'Listview füllen
    With ListView1
        .ListItems.Clear
        Do While Not RsA.EOF
            Set li = .ListItems.Add(, , GetFld(RsA.Fields("Kunden-Code")))
            li.SubItems(1) = GetFld(RsA!Firma)
            li.SubItems(2) = GetFld(RsA!Kontaktperson)
            li.SubItems(3) = GetFld(RsA!Land)
            li.SubItems(4) = GetFld(RsA!Plz)
            li.SubItems(5) = GetFld(RsA!Ort)
            li.SubItems(6) = GetFld(RsA!Strasse)
            RsA.MoveNext
        Loop
        If .Visible Then
            .SetFocus
        End If
    End With
    
    'Recordset an Datagrid binden
    With DataGrid1
        Set .DataSource = RsA
        RsA.MoveFirst
    End With
    
    Me.MousePointer = vbDefault
End Sub

Private Sub Command2_Click()
    'wechseln zwischen ListView und Datagrid
    
    If DataGrid1.Visible = False Then
        ListView1.Visible = False
        DataGrid1.Visible = True
        Command2.Caption = "zeigen ListView"
        DataGrid1.SetFocus
    Else
        ListView1.Visible = True
        DataGrid1.Visible = False
        Command2.Caption = "zeigen DataGrid"
        ListView1.SetFocus
    End If
End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
    'Sortieren Datagrid
    
    Static Sorter As String
    
    With RsA
        If Sorter = "Desc" Then
            .Sort = .Fields(ColIndex).Name & " Asc"
            Sorter = "Asc"
        Else
            .Sort = .Fields(ColIndex).Name & " Desc"
            Sorter = "Desc"
        End If
    End With
End Sub

Private Sub Form_Load()
    
    Dim myPath As String
    
    Me.Height = (600 - 30) * Screen.TwipsPerPixelY
    Me.Width = 800 * Screen.TwipsPerPixelX
    
    myPath = App.Path
    If Right(myPath, 1) <> "\" Then
        myPath = myPath & "\"
    End If
    
    With ListView1
        .Left = 0
        .Top = 3000
        .View = lvwReport
        .FullRowSelect = True
        .LabelEdit = lvwManual
        .ColumnHeaders.Clear
        .ColumnHeaders.Add , , "Code", 800
        .ColumnHeaders.Add , , "Firma", 2400
        .ColumnHeaders.Add , , "Kontaktperson", 2400
        .ColumnHeaders.Add , , "Land", 600
        .ColumnHeaders.Add , , "Plz", 700
        .ColumnHeaders.Add , , "Ort", 2400
        .ColumnHeaders.Add , , "Strasse", 2400
    End With
    
    With DataGrid1
        .Left = 0
        .Top = ListView1.Top
        .Visible = False
    End With
    
    With Text1
        .Width = 1500
        .Height = 315
        .Left = 300
        .Top = 2400
        .Text = "A"
    End With
    
    With Label1
        .Top = 2100
        .Left = 300
        .Height = 210
        .Width = 1500
        .Caption = " Firma"
    End With
    
    With Command1
        .Width = 1500
        .Height = 375
        .Left = 2100
        .Top = 2400
        .Caption = "Daten lesen"
    End With
    
    With Command2
        .Width = 1500
        .Height = 375
        .Left = 3900
        .Top = 2400
        .Caption = "zeigen Datagrid"
    End With
    
    Me.Show
    
    'Connection zur Nordwind.mdb im Applikationspfad
    With CnA
        .CursorLocation = adUseClient
        .Mode = adModeShareDenyNone
        ' für Access 97: 3.51  für 2000: 4.0
        .Provider = "Microsoft.Jet.OLEDB.3.51"
        .ConnectionString = "Data Source=" & myPath & "NWIND.MDB"
        Debug.Print .ConnectionString
        .Open
    End With
    
End Sub

Private Sub Form_Resize()
    'Listview und Datagrid dynamisch anpassen
    
    With ListView1
        .Width = Me.ScaleWidth
        .Height = Me.ScaleHeight - .Top
    End With
    With DataGrid1
        .Width = Me.ScaleWidth
        .Height = Me.ScaleHeight - .Top
    End With
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    If RsA.State = adStateOpen Then
        'Recordset abhängen
        Set DataGrid1.DataSource = Nothing
        'schliessen
        RsA.Close
        'Object zerstören
        Set RsA = Nothing
    End If
    
    'Connection schliessen
    CnA.Close
End Sub

Private Function GetFld(Field As Variant) As String
    'Check dB-Field auf NullString
    
    If IsNull(Field) Then
        GetFld = ""
    Else
        GetFld = Field
    End If
End Function

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ' sortieren Listview
    
    With ListView1
        .SortKey = ColumnHeader.Index - 1
        If .SortOrder = lvwAscending Then
            .SortOrder = lvwDescending
        Else
            .SortOrder = lvwAscending
        End If
        .Sorted = True
        .ListItems(1).Selected = True
    End With
End Sub


'---- Ende Formular "Testbereich" alias Testbereich.frm  ----
'------- Ende Projektdatei ADO_Listview_Datagrid.vbp  -------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.