2016-05-19 6 views
-1
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

コレクションが無重複キーで要素のみを受け入れます。このコレクションのエラーの要素に関連付けられている

それはいくつかの時点で、あなたのコードは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 

:「しかしで 『キー』あなたはすでにあなたがこのスニペットを採用することができます何が起こっているかを調べるために、以前に追加された要素

に与えましたあなたは、コレクションに要素を追加しているので、Rコード私はこのようにそれはあなたが内側にcolResults.Add sVal, oField.Name文を残しておきたいことがありケースである必要があり、それが可能同じNullキー

に要素を追加することもIsNull(oField.Value)場合、それが起こっていると思うことができ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 
+0

@ravindersingh:あなたはそれを通過しましたか? – user3598756

関連する問題