检查VB6集合中是否存在记录？

Check if a record exists in a VB6 collection?

我在当前的工作场所继承了一个大型VB6应用程序。我在工作中正在学习VB6，遇到很多问题。目前的主要问题是我不知道如何检查Collection对象中是否存在键。有人可以帮忙吗？

我的标准功能非常简单。无论元素类型如何，它都将起作用，因为它不会理会任何分配，它仅执行collection属性get。

1
2
3
4
5
6
7
8

Public Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean

On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear

End Function

@Mark Biek您的keyExists与我的标准Exists()函数非常匹配。为了使该类对暴露于COM的集合和检查数字索引更有用，我建议将sKey和myCollection更改为不键入。如果该函数将与对象集合一起使用，则需要" set"(在设置val的行上)。

编辑：令我感到困惑的是，我从未注意到基于对象和基于值的Exists()函数有不同的要求。我很少将集合用于非对象，但这似乎是一个缺陷的完美瓶颈，当我需要检查存在性时很难跟踪。因为如果错误处理程序已经处于活动状态，错误处理将失败，因此需要两个函数来获取新的错误范围。只需调用Exists()函数：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

并验证功能：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

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

我一直用这样的功能来做到这一点：

1
2
3
4
5
6
7
8
9
10
11

public function keyExists(myCollection as collection, sKey as string) as Boolean
on error goto handleerror:

dim val as variant

val = myCollection(sKey)
keyExists = true
exit sub
handleerror:
keyExists = false
end function

正如Thomas所指出的，您需要设置一个对象而不是Let。这是我的库中用于值和对象类型的常规函数??：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

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

就像Thomas所建议的那样，您可以将Collection类型更改为Object来概括这一点。大多数集合类都共享.Item(key)语法，因此实际上可能有用。

编辑好像我被托马斯本人打败了。但是，为了更容易重用，我个人更喜欢没有私有依赖项的单个函数。

语句"如果错误处理程序已经处于活动状态，错误处理将失败"只是部分正确的说法。

您的例程中可以有多个错误处理程序。
因此，一个功能只能在一个功能中提供相同的功能。
只是这样重写代码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

但是，如果仅将代码合并到例程的TryNonObject部分中，则将产生相同的信息。
对于对象和非对象都将成功。
但是，这将加快非对象代码的执行速度，因为您只需执行一个语句即可断言该项目存在于集合中。

如果在Collection中不存在该键时使用错误处理程序来捕获情况，则使用"打破所有错误"选项进行调试会很烦人。为了避免不必要的错误，我经常创建一个类，该类在Collection中具有存储的对象，而在Dictionary中具有所有键。字典具有exist(key)-function，因此我可以在尝试从集合中获取对象之前调用它。您只能将字符串存储在字典中，因此如果需要存储对象，则仍然需要Collection。

看到
http://www.visualbasic.happycodings.com/Other/code10.html
该实现的优点是还可以选择返回找到的元素，并且可以使用对象/本机类型(根据注释)。

转载于此，因为该链接不再可用：

确定项目是否存在于集合中

以下代码显示了如何确定集合中是否存在某个项目。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

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

详情请参见：https：//web.archive.org/web/20140723190623/http：//visualbasic.happycodings.com/other/code10.html#sthash.MlGE42VM.dpuf

更好的解决方案是编写TryGet函数。很多时候，您将要进行检查，然后再获取项目。同时执行可节省时间。

1
2
3
4
5
6
7

public Function TryGet(key as string, col as collection) as Variant
on error goto errhandler
Set TryGet= col(key)
exit function
errhandler:
Set TryGet = nothing
end function

在寻找这样的功能时，我将其设计如下。
这应该适用于对象和非对象，而无需分配新变量。

1
2
3
4
5
6
7
8
9
10
11
12
13

Public Function Exists(ByRef Col As Collection, ByVal Key) As Boolean
On Error GoTo KeyError
If Not Col(Key) Is Nothing Then
Exists = True
Else
Exists = False
End If

Exit Function
KeyError:
Err.Clear
Exists = False
End Function