Vérifier s'il existe un enregistrement dans un VB6 collection?

@Mark Biek Votre keyExists correspond le plus à mon niveau Exists() fonction. Pour faire la classe la plus utile pour COM-exposés des collections et la vérification des indices numériques, je vous recommande de changer sKey et myCollection de ne pas être tapé. Si la fonction est destiné à être utilisé avec une collection d'objets, " set " est nécessaire (sur la ligne où val est réglé).

MODIFIER: Il était sur écoute-moi que je n'ai jamais remarqué des exigences différentes pour un objet et la valeur en fonction Exists() fonction. J'ai très rarement utiliser des collections pour les non-objets, mais il semblait tellement parfait goulot d'étranglement pour un bug qui serait si dur pour traquer quand j'avais besoin de vérifier l'existence. Parce que erreur de manipulation échoue si un gestionnaire d'erreur, il est déjà actif, deux fonctions sont nécessaires pour obtenir un nouveau périmètre d'erreurs. Seule la Exists() fonction doit jamais être appelé:

Public Function Exists(col, index) As Boolean
On Error GoTo ExistsTryNonObject
    Dim o As Object

    Set o = col(index)
    Exists = True
    Exit Function

ExistsTryNonObject:
    Exists = ExistsNonObject(col, index)
End Function

Private Function ExistsNonObject(col, index) As Boolean
On Error GoTo ExistsNonObjectErrorHandler
    Dim v As Variant

    v = col(index)
    ExistsNonObject = True
    Exit Function

ExistsNonObjectErrorHandler:
    ExistsNonObject = False
End Function

Et de vérifier la fonctionnalité:

Public Sub TestExists()
    Dim c As New Collection

    Dim b As New Class1

    c.Add "a string", "a"
    c.Add b, "b"

    Debug.Print "a", Exists(c, "a") ' True '
    Debug.Print "b", Exists(c, "b") ' True '
    Debug.Print "c", Exists(c, "c") ' False '
    Debug.Print 1, Exists(c, 1) ' True '
    Debug.Print 2, Exists(c, 2) ' True '
    Debug.Print 3, Exists(c, 3) ' False '
End Sub

Comme l'a souligné Thomas, vous devez fixer un objet au lieu de le Laisser. Voici une fonction à partir de ma bibliothèque qui fonctionne pour la valeur et les types d'objet:

Public Function Exists(ByVal key As Variant, ByRef col As Collection) As Boolean

'Returns True if item with key exists in collection

On Error Resume Next

Const ERR_OBJECT_TYPE As Long = 438
Dim item As Variant

'Try reach item by key
item = col.item(key)

'If no error occurred, key exists
If Err.Number = 0 Then
    Exists = True

'In cases where error 438 is thrown, it is likely that
'the item does exist, but is an object that cannot be Let
ElseIf Err.Number = ERR_OBJECT_TYPE Then

    'Try reach object by key
    Set item = col.item(key)

    'If an object was found, the key exists
    If Not item Is Nothing Then
        Exists = True
    End If

End If

Err.Clear

End Function

Comme il est également conseillé par Thomas, vous pouvez modifier le type de Collection pour Objet de généraliser cette. L' .Élément(clé) de la syntaxe est partagé par la plupart des classes de collection, de sorte qu'en fait, pourrait être utile.

MODIFIER Semble que j'ai été battu à coup de poing un peu par Thomas lui-même. Toutefois, pour faciliter la réutilisation personnellement, je préfère une seule fonction avec aucune privé dépendances.

L'état "erreur de manipulation échoue si un gestionnaire d'erreur, il est déjà actif" n'est que partiellement juste.

Vous pouvez avoir plusieurs gestionnaires d'erreur dans votre routine.

On peut donc accueillir les mêmes fonctionnalités dans une seule fonction.

Juste de réécrire votre code comme ceci:

Public Function Exists(col, index) As Boolean
Dim v As Variant

TryObject:
    On Error GoTo ExistsTryObject
        Set v = col(index)
        Exists = True
        Exit Function

TryNonObject:
    On Error GoTo ExistsTryNonObject

        v = col(index)
        Exists = True
        Exit Function

ExistsTryObject:
   ' This will reset your Err Handler
   Resume TryNonObject

ExistsTryNonObject:
        Exists = False
End Function

Toutefois, si vous avez été seulement intégrer le code dans le TryNonObject section de la routine, cela donnerait les mêmes informations.

Une réussite pour les deux Objets, et non des objets.
Il permettra d'accélérer votre code pour les non-objets, cependant, puisque vous n'avez qu'à effectuer une seule déclaration pour affirmer que l'élément existe au sein de la collection.

voir
http://www.visualbasic.happycodings.com/Other/code10.html
la mise en œuvre d'ici a l'avantage de également la possibilité de retourner l'élément trouvé, et travaille avec l'objet/types natifs (selon les commentaires).

reproduit ici puisque le lien n'est plus disponible:

Déterminer si un élément existe dans une collection

Le code suivant vous montre comment déterminer si un élément existe au sein d'une collection.

Option Explicit
'Purpose     :  Determines if an item already exists in a collection
'Inputs      :  oCollection         The collection to test for the existance of the item
'               vIndex              The index of the item.
'               [vItem]             See Outputs
'Outputs     :  Returns True if the item already exists in the collection.
'               [vItem] The value of the item, if it exists, else returns "empty".
'Notes       :
'Example     :
Function CollectionItemExists(vIndex As Variant, oCollection As Collection, Optional vItem As Variant) As Boolean
On Error GoTo ErrNotExist
'Clear output result
If IsObject(vItem) Then
Set vItem = Nothing
Else
vItem = Empty
End If
If VarType(vIndex) = vbString Then
'Test if item exists
If VarType(oCollection.Item(CStr(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(CStr(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(CStr(vIndex))
End If
Else
'Test if item exists
If VarType(oCollection.Item(Int(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(Int(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(Int(vIndex))
End If
End If
'Return success
CollectionItemExists = True
Exit Function
ErrNotExist:
CollectionItemExists = False
On Error GoTo 0
End Function
'Demonstration routine
Sub Test()
Dim oColl As New Collection, oValue As Variant
oColl.Add "red1", "KEYA"
oColl.Add "red2", "KEYB"
'Return the two items in the collection
Debug.Print CollectionItemExists("KEYA", oColl, oValue)
Debug.Print "Returned: " & oValue
Debug.Print "-----------"
Debug.Print CollectionItemExists(2, oColl, oValue)
Debug.Print "Returned: " & oValue
'Should fail
Debug.Print CollectionItemExists("KEYC", oColl, oValue)
Debug.Print "Returned: " & oValue
Set oColl = Nothing
End Sub

• En savoir plus: https://web.archive.org/web/20140723190623/http://visualbasic.happycodings.com/other/code10.html#sthash.MlGE42VM.dpuf