ADO Recordset 添加到 ListView

Public Sub RSToListview(ByRef RS As ADODB.Recordset, ByRef LV As ListView, Optional bClr As Boolean)
    On Error Goto errHand
    LV.ListItems.Clear


    If RS.State = adStateOpen Then


        If Not (RS.BOF And RS.EOF) Then
            Dim i As Integer, j As Integer, iCt As Integer
            Dim lngType() As Long
            Dim sngPct() As Single
            Dim lWid() As Long, lTotalWid As Long
            Dim li As ListItem
            '// LV must be set to lvwreport to show
            '     ColumnHeaders...
            LV.View = lvwReport
            iCt = RS.Fields.Count - 1
            ReDim lWid(0 To iCt)
            ReDim sngPct(0 To iCt)
            ReDim lngType(0 To iCt)


            For i = 0 To iCt
                '// Make sure it's at least 10 wide...


                If RS(i).DefinedSize > 9 Then
                    lWid(i) = RS(i).DefinedSize
                Else
                    lWid(i) = 10
                End If
                lTotalWid = lTotalWid + lWid(i)
            Next


            For i = 0 To iCt
                sngPct(i) = lWid(i) / lTotalWid
                lngType(i) = RS.Fields(i).Type
            Next


            If bClr = True Then
                LV.ColumnHeaders.Clear
            End If


            If LV.ColumnHeaders.Count = 0 Then


                For i = 0 To iCt
                    LV.ColumnHeaders.Add , , RS.Fields(i).Name, LV.Width * sngPct(i)
                Next
            Else


                For i = 0 To iCt
                    LV.ColumnHeaders(i + 1).Width = LV.Width * sngPct(i)
                Next
            End If
            RS.MoveFirst


            While Not RS.EOF


                If lngType(0) = adBoolean Then


                    If RS.Fields(0).Value = vbFalse Then
                        Set li = LV.ListItems.Add(, , "NO")
                    Else
                        Set li = LV.ListItems.Add(, , "YES")
                    End If
                Else
                    Set li = LV.ListItems.Add(, , RS.Fields(0).Value)
                End If


                If iCt > 0 Then


                    For j = 1 To iCt


                        If lngType(j) = adBoolean Then


                            If RS.Fields(j).Value = vbFalse Then
                                li.ListSubItems.Add , , "NO"
                            Else
                                li.ListSubItems.Add , , "YES"
                            End If
                        Else
                            li.ListSubItems.Add , , RS.Fields(j).Value
                        End If
                    Next
                End If
                RS.MoveNext
            Wend
            LV.Sorted = True
            LV.SortKey = 0
        End If
    End If
    exitSub:
    Exit Sub
    errHand:
    MsgBox "Error In RSToListview: " & Err.Description & " ", vbCritical
End Sub