Option Explicit

Private Sub Form_Load()
  With lstvMain
    .ColumnHeaders.Clear
    .ListItems.Clear
    .View = lvwReport
    .FullRowSelect = True
    .LabelEdit = lvwManual
    .Font.Size = 8
  End With
End Sub

Private Sub cmdLaden_Click()
  Build_ListView
  cmdLaden.Caption = "Liste neu laden"
End Sub

Private Sub Build_ListView()
  Dim strPath As String

  Dim objConn As ADODB.Connection
  Dim rsMain  As ADODB.Recordset

  Dim intFieldsCnt As Integer
  Dim sngLstVWidth As Single
  Dim sngColWidth As Single

  Dim i As Integer
  Dim itmX As ListItem

  On Error GoTo err_Handler

  strPath = App.Path
  If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

  Set objConn = New ADODB.Connection
  Set rsMain = New ADODB.Recordset

  With objConn
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .ConnectionString = "Data Source=" & strPath & "datenbank.mdb"
    .Open
  End With

  With rsMain
    .ActiveConnection = objConn
    .CursorLocation = adUseClient
    .Source = "SELECT tbl_Adressen.* FROM tbl_Adressen"
    .Open
  End With

  intFieldsCnt = rsMain.Fields.Count - 1

  sngLstVWidth = lstvMain.Width * 0.99
  sngColWidth = sngLstVWidth / intFieldsCnt
  If sngColWidth < 2000 Or sngColWidth > 2200 Then
    sngColWidth = 2000
  End If

  With lstvMain
    .ColumnHeaders.Clear
    .ListItems.Clear

    .ColumnHeaders.Add , , "ID", 0
    For i = 1 To intFieldsCnt
      .ColumnHeaders.Add , , rsMain.Fields(i).Name, sngColWidth
    Next
  End With

  While Not rsMain.EOF
    Set itmX = lstvMain.ListItems.Add(, _
          "A" & CStr(rsMain.Fields(0)), CStr(rsMain.Fields(0)))

    For i = 1 To intFieldsCnt
      If Not IsNull(rsMain.Fields(i)) Then
        itmX.SubItems(i) = rsMain.Fields(i)
      End If
    Next i

    rsMain.MoveNext
  Wend

byebye:
  If Not rsMain Is Nothing Then
    rsMain.Close
    Set rsMain = Nothing
  End If

  If Not objConn Is Nothing Then
    objConn.Close
    Set objConn = Nothing
  End If

  On Error GoTo 0
  Exit Sub

err_Handler:
  MsgBox "Fehlernummer " & Err.Number & Chr$(13) & Error$(Err), _
            vbCritical, "Fehler"
  Resume byebye
End Sub