此键已与此集合错误的元素相关联

时间:2016-05-19 09:08:39

标签: vba

    Dim colResults  As New Collection
       Dim intI         As Integer
       Dim objConn      As ADODB.Connection
       Dim objCmd       As ADODB.Command
       Dim objRs        As ADODB.Recordset
       Dim strErrText   As String
       Dim oField       As ADODB.Field
       Dim sVal

       On Error GoTo RaiseError

       Set objConn = New ADODB.Connection
       objConn.open DBConnString
       Set objCmd = New ADODB.Command
       Set objCmd.ActiveConnection = objConn
       objCmd.CommandType = adCmdStoredProc
       objCmd.CommandText = "spSearchHistory_Read"
       objCmd.Parameters(1) = CLng(sUserID)
       Set objRs = objCmd.Execute

       intI = 1

       For Each oField In objRs.fields
        If IsNull(oField.Value) Then
                    'fix null vals so the front end doesnt trip up trying to access them
                    sVal = ""
        Else
            If oField.Type = adDBTimeStamp Then
                        sVal = Format(oField.Value, "dd/mm/yyyy hh:mm")
            Else
                        sVal = oField.Value
            End If
        End If
                colResults.Add sVal, oField.Name
        Next

       objConn.Close
       Set SearchHistory = colResults
       Set objRs = Nothing
       Set objCmd = Nothing
       Set objConn = Nothing

       GoTo END_OF_FUNC

RaiseError:
       strErrText = "CutomerSearch.SearchHistory" & vbTab & " - " & vbTab & Err.Number & " - " & Err.Description
       WriteToLogFile strErrText
       WriteToEventLog strErrText

END_OF_FUNC:

1 个答案:

答案 0 :(得分:0)

集合只接受没有重复键的元素

您的代码必须在某个时刻尝试向colResults添加新的"值"但是有一个"键"你已经给了以前添加的元素

了解您可以采用此代码段的内容:

        On Error Resume Next '<~~ temporarily suspend your error handling mode to detect duplicates
        colResults.Add sVal, oField.Name '<~~ this will result in error 457 if trying to add a new item with a key you assigned to an element already in collection
        If Err <> 0 Then
            'possible code to handle duplicates
            'On Error GoTo RaiseError '<~~ resume your error handling mode
            '... code

        End If
        On Error GoTo RaiseError '<~~ resume your error handling mode

从您的代码中我可以猜到它正在发生,因为您即使IsNull(oField.Value)也在向集合中添加元素,因此可以添加具有相同Null键的元素

如果您希望在colResults.Add sVal, oField.Name块中保留Else-End If语句,则应如下所示

If IsNull(oField.Value) Then
            'fix null vals so the front end doesnt trip up trying to access them
            sVal = ""
Else
    If oField.Type = adDBTimeStamp Then
                sVal = Format(oField.Value, "dd/mm/yyyy hh:mm")
    Else
                sVal = oField.Value
    End If
    colResults.Add sVal, oField.Name '<~~ add elements only if oField.Value is not Null
End If