SELECT DISTINCT on multiselect listbox errors out on fields that contain null values or too many values

问题

My code below shows distinct values for items selected in a multi-select listbox. It works perfectly except under the following conditions:

Field contains some or all null values (Invalid use of Null)
Field contains too many distinct values, such as last name in a file with 11,000 records. Error messages vary between (Out of memory) and (System resource exceeded)

The code ...

Private Sub ShowScrubbedDistinct_Click()
Dim cn1 As ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim cmd1 As New ADODB.Command
Dim varItem As Variant
Dim aFields() As aArray
Dim NumRows As Integer
Dim NumFields As Integer
Dim colcount As Integer
Dim colwidths As String
Dim strRow As String
Dim cnt1 As Integer
Dim cnt2 As Integer

Me.ScrubbedFieldVal2.RowSource = ""

ReDim aFields(50)
For cnt1 = 1 To 50
    ReDim aFields(cnt1).fValue(12000)
Next

NumRows = 0
colcount = 0

For Each varItem In Me!ScrubbedList.ItemsSelected
    colcount = colcount + 1
    aFields(colcount).fName = Me!ScrubbedList.ItemData(varItem)
    NumFields = 0

    rs1.Open "SELECT DISTINCT " & Me!ScrubbedList.ItemData(varItem) & "  FROM Scrubbed", 
CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    If rs1.RecordCount > NumRows Then NumRows = rs1.RecordCount
    strRow = strRow & Me!ScrubbedList.ItemData(varItem) & ";"

    While Not rs1.EOF
        NumFields = NumFields + 1
        If NumFields > NumRows Then
            NumRows = NumFields
        End If

         aFields(colcount).fValue(NumFields) = rs1(0)

        rs1.MoveNext
    Wend
    rs1.Close
Next varItem
strRow = Left(strRow, Len(strRow) - 1)

Me.ScrubbedFieldVal2.ColumnCount = colcount
Me.ScrubbedFieldVal2.ColumnWidths = Mid(colwidths, 2)
Me.ScrubbedFieldVal2.AddItem (strRow)

For cnt1 = 1 To NumRows

    strRow = ""
    For cnt2 = 1 To colcount
        If aFields(cnt2).fValue(cnt1) = "" Then
            strRow = strRow & ";"
        Else
            strRow = strRow & aFields(cnt2).fValue(cnt1) & ";"
        End If
    Next
    strRow = Left(strRow, Len(strRow) - 1)
    Me.ScrubbedFieldVal2.AddItem (strRow)

    Next

    End Sub

来源：https://stackoverflow.com/questions/11970982/select-distinct-on-multiselect-listbox-errors-out-on-fields-that-contain-null-va

标签

ms-access

ms-access-2003