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:
答案 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