Wie zeige ich den Inhalt eines Recordsets in einem ListView an?

Der folgende Code ist als Beispiel gedacht. Die Datenbank "nwind.mdb" wird in dem Verzeichnis gesucht, aus dem heraus das Beispiel gestartet wurde.

Option Explicit

' Prefix und Suffix für den Schlüssel
' mindestens einer von beiden sollte einen Text enthalten, 
' der nicht als Zahl interpretiert werden kann
Private Const mcstrKeyPrefix As String = "Key "
Private Const mcstrKeySuffix As String = VBA.Constants.vbNullString

Private Property Get ApplicationPath() As String
    Static strPath As String
    
    If Len(strPath) = 0 Then
        '   Pfad ermitteln und sicherstellen, daß ein BackSlash
        '   am Ende des Pfades steht
        strPath = App.Path
        If Right$(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
    End If
    
    '   Pfad zur Anwendung zurückgeben
    ApplicationPath = strPath
End Property

Private Sub Form_Load()
    Dim objCN As ADODB.Connection
    Dim objRS As ADODB.Recordset
    
    ' einige Grundeinstellungen des Listviews
    With ListView1
        .View = lvwReport
        .LabelEdit = lvwManual
        .FullRowSelect = True
        .GridLines = True
    End With
    
    ' Datenbank anbinden
    Set objCN = New ADODB.Connection
    With objCN
        .CursorLocation = adUseClient
        .Mode = adModeReadWrite
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Data Source") = ApplicationPath & "nwind.mdb"
        Call .Open
    End With
    
    ' Eine Abfrage ausführen
    Set objRS = New ADODB.Recordset
    With objRS
        Set .ActiveConnection = objCN
        .CursorLocation = adUseServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockOptimistic
        .Source = "SELECT [Personal-Nr], Nachname, Vorname " & _
                  "FROM Personal " & _
                  "ORDER BY Nachname ASC, Vorname ASC;"
        Call .Open(Options:=adCmdText)
    End With
    
    ' Ergebnis im Listview darstellen
    Call Rs2Lv(objRS, ListView1, "Personal-Nr")
    
    ' Abfrage schließen
    Call objRS.Close
    Set objRS = Nothing
    
    ' Datenbankverbindung schließen
    Call objCN.Close
    Set objCN = Nothing
End Sub

Private Sub Rs2Lv( _
                ByRef myRS As ADODB.Recordset, _
                ByRef oLV As ListView, _
                Optional ByVal KeyColumn As String = vbNullString)
    ' zeigt den Inhalt eines Recordsets in einem Listview an
    ' myRS = ein ADO Recordset
    ' oLV = Verweis auf ein ListView
    ' KeyColumn = Optional. Name des PrimaryKeys
    ' (Achtung! Die Spalte muss im Recordset enthalten sein)
    Dim i As Long
    Dim Itmx As ListItem
    
    ' Inhalt und Spalten löschen
    Call oLV.ListItems.Clear
    Call oLV.ColumnHeaders.Clear
    
    ' Spalten des Recordsets hinzufügen
    For i = 0 To myRS.Fields.Count - 1
        Call oLV.ColumnHeaders.Add(, , myRS.Fields(i).Name)
    Next i
    
    ' Daten auslesen und eintragen
    While Not myRS.EOF
        ' Neue Zeile einfügen
        Set Itmx = oLV.ListItems.Add()
        
        ' die 1. Spalte (.Text) enthält das 1. Feld
        If Not (IsNull(myRS.Fields.Item(0).Value)) Then
            Itmx.Text = myRS.Fields.Item(0).Value
        Else
            'Itmx.Text = "<nicht angegeben>"
            Itmx.Text = VBA.Constants.vbNullString
        End If
        
        ' nun alle weiteren Felder (.SubItems) einfügen
        For i = 1 To myRS.Fields.Count - 1
            If Not (IsNull(myRS.Fields.Item(i).Value)) Then
                Itmx.SubItems(i) = myRS.Fields.Item(i).Value
            Else
                'Itmx.SubItems(i) = "<nicht angegeben>"
                Itmx.SubItems(i) = VBA.Constants.vbNullString
            End If
        Next i
        
        ' Eventuell noch den Key (oder auch Tag) mit dem
        ' PrimaryKey füllen, sofern angegeben
        If (LenB(KeyColumn) <> 0) Then
            ' Prefix und Suffix wurde eingefügt für den Fall, dass 
            ' der Primarykey nummerisch ist, denn der Key eines 
            ' ListItems kann nicht nummerisch sein
            Itmx.Key = mcstrKeyPrefix & _
                       myRS.Fields.Item(KeyColumn).Value & _
                       mcstrKeySuffix
        End If
        
        Set Itmx = Nothing
        
        ' Wichtig: Datensatzzeiger weiterschieben
        ' (sonst Endlosschleife)!
        myRS.MoveNext
    Wend
End Sub

Private Sub ListView1_DblClick()
    Dim strKey As String
    
    If Not ListView1.SelectedItem Is Nothing Then
        strKey = ListView1.SelectedItem.Key
        If (LenB(strKey) <> 0) Then
            strKey = Mid$(strKey, Len(mcstrKeyPrefix) + 1)
            strKey = Left$(strKey, Len(strKey) - Len(mcstrKeySuffix))
            Call MsgBox("Sie haben den Datensatz " & _
                        strKey & _
                        " angeklickt.", vbOKOnly Or vbInformation)
        End If
    End If
End Sub

Listing 1: Recordset in einem ListView anzeigen