cxf传递复杂参数
Passing lists and complex data to VB 6 and VBA functions
将列表和复杂数据传递给VB 6和VBA功能
1.简介 (1. Introduction)
在编辑有关使用SPLIT()函数的AlainBryden的文章( http:/A_1480.html) on using the SPLIT() function, I realized that there was a related topic that needed to be covered. For Alain's article, he needed to pass some delimiters into the parsing function. The parsing function iterates through the characters in the string and parses data accordingly. http:/A_1480.html )时,我意识到需要涉及一个相关主题。 对于Alain的文章,他需要将一些定界符传递到解析函数中。 解析函数遍历字符串中的字符并相应地解析数据。I also edited a similar article by AngelIII (http:/A_1536.html) where he passes a (delimited) list of values to a stored procedure. Although AngelIII is working in the SQL Server environment, the problem is very similar to this one.
我还编辑了AngelIII( http:/A_1536.html )的类似文章,其中他将(定界)值列表传递给存储过程。 尽管AngelIII在SQL Server环境中工作,但问题与此非常相似。
Problem definition
问题定义
We might need to pass some non-trivial, certainly more than single character delimiters, data into a routine (Sub or Function). As our data needs grow more complex, this will be similar to passing an object, such as a recordset or control, as a parameter. However, I want this article to concentrate on passing multiple pieces of data through a single parameter, rather than passing a single complex parameter.
我们可能需要将一些非平凡的,肯定比单字符定界符更多的数据传递到例程(Sub或Function)中。 随着我们的数据需求变得越来越复杂,这类似于将对象(例如记录集或控件)作为参数传递。 但是,我希望本文专注于通过单个参数传递多个数据,而不是传递单个复杂参数。
I'm going to add other criteria to consider. In the AlainBryden article, his solutions were supplied to the parsing routine as string literals. As a result, I'm going to start with that premise. After showing a method that meets criterion, I'm going to drop the 'single line invocation' criterion and expand to methods more suitable for larger and more complex list passing.
我将添加其他要考虑的条件。 在AlainBryden的文章中,他的解决方案作为字符串文字提供给了解析例程。 结果,我将从这个前提开始。 在显示出符合标准的方法之后,我将删除“单行调用”标准,并扩展到更适合于更大和更复杂的列表传递的方法。
Applicable development environments
适用的开发环境
This material applies to VB6 and VBA. The examples are written to this version of the VB language, although it is likely that most of these examples will compile in a VB.Net environment. It is important to remember that you are creating an interface between the calling code and the called routine. There are expectations that must be met by both parties.
该材料适用于VB6和VBA。 尽管这些示例中的大多数可能会在VB.Net环境中进行编译,但这些示例都是使用此版本的VB语言编写的。 重要的是要记住,您正在创建调用代码和被调用例程之间的接口。 双方都必须满足期望。
Note: Many of the methods can be used in VB5 and VBScript, but you might have to write some more code, supplementing the additional functions in VB6, and use Variant data types.
许多方法可以在VB5和VBScript中使用,但是您可能必须编写更多代码,以补充VB6中的附加功能,并使用Variant数据类型。
In the VB.Net environment, our options are much greater and the intrinsic .Net framework provides many more functions and data types. This article is not written for the VB.Net developer's options. However, I will mention some of the applicable .Net name space alternatives when possible.
在VB.Net环境中,我们的选择更多,固有的.Net框架提供更多的功能和数据类型。 本文并非针对VB.Net开发人员的选项而编写。 但是,我将在可能的情况下提及一些适用的.Net名称空间替代方案。
But what about Regular Expressions?
但是正则表达式呢?
The two articles leading up to this were about parsing. However, this article is about efficiently passing lists of items through a routine's parameter -- NOT parsing. This why I'm not going to recommend or cover RegEx as a solution in this article:
导致此问题的两篇文章都是关于解析的。 但是,本文旨在通过例程的参数有效地传递项目列表-而不是解析。 这就是为什么在本文中我不推荐或不介绍RegEx作为解决方案的原因:
If we are going to pass a list to a routine, we want it to be as simple as possible. Simple is easy. Easy is efficient. RegEx is for complicated problems. After all, why create another problem for ourselves?
如果我们要将列表传递给例程,我们希望它尽可能简单。 简单就是容易。 简单就是有效。 RegEx适用于复杂的问题。 毕竟,为什么还要为自己制造另一个问题?
While RegEx parsing is powerful, it is also very slow compared with the native parsing operations.
尽管RegEx解析功能强大,但与本机解析操作相比,它也非常慢。
Since I've mentioned RegExp, there is an excellent article (http:/A_1336.html) on the subject for VB developers.
自从我提到RegExp以来,有一篇非常不错的文章( http:/A_1336.html )针对VB开发人员。
2.使用分隔列表的简单解决方案 (2. Simple solution using a delimited list)
传递字符串列表的最简单方法是传递定界字符串。 由于字符串解析文章向我们展示了多个单字符定界符解析,因此迭代传递的字符串中的每个字符是一项简单的任务。 但是,我们希望能够传递长度不一定相同的多个多字符字符串。 因此,我们可以扩展该文章的工作。One of the parsing article's reference links passes two parameters: the delimited string and the delimiter character. (show example code)
解析文章的参考链接之一传递了两个参数:定界字符串和定界符字符。 (显示示例代码)
You can combine the two parameters, as I demonstrate below, by concatenating the two parameters. In this example, the delimiter character is the first character.
您可以通过串联两个参数来组合这两个参数,如下文所示。 在此的示例分隔符是第一个字符。
Now we have a simple method for passing multiple multi-character delimiters.
现在,我们有了一种简单的方法来传递多个多字符定界符。
'=======================================================
'ReplaceAndSplit2 is based on the alainbryden routine
'Uses the native REPLACE() function to replace all delimiters with a common
'delimiter, and then splits the modified string on that delimiter.
'=======================================================
Function ReplaceAndSplit2(ByRef parmText As String, _
ByRef parmDelimiters As String) As String()
Dim DelimCount As Long, DelimLoop As Long
Dim strDelims() As String
Dim strTemp As String, Delim1 As String
Dim ThisDelim As String
strTemp = parmText
strDelims = Split(Mid(parmDelimiters, 2), Mid(parmDelimiters, 1, 1))
Delim1 = parmDelimiters(0)
DelimCount = UBound(strDelims)
For DelimLoop = 1 To DelimCount
ThisDelim = strDelims(DelimLoop)
If InStr(strTemp, ThisDelim) <> 0 Then _
strTemp = Replace(strTemp, ThisDelim, Delim1)
Next DelimLoop
ReplaceAndSplit2 = Split(strTemp, Delim1)
End Function
Usage: If we wanted to parse a web page's HTML to get the link data, we might invoke this routine with:
用法:如果我们想解析网页HTML以获取链接数据,则可以使用以下方法调用此例程:
Dim strHTML() As String
Dim strLinks() As String
Dim lngLoop As Long, lngLink As Long
strHTML = ReplaceAndSplit2(strPageContents, "\<a \</a>")
ReDim strLinks(1 To UBound(strHTML)\2)
For lngLoop = 1 To UBound(strHTML) Step 2
lngLink = lngLink + 1
strLinks(lngLink) = strHTML(lngLoop)
Next
3.传递数组 (3. Pass an Array)
内在的VB Split()函数具有其他参数。 您可以限制将要作用的找到的定界符的数量,并且可以覆盖其定界符字符串的区分大小写的比较。 如上文所述,通过分隔的字符串传递所需的数据将非常困难。 我们将需要一个更复杂的复杂数据结构。It is possible to pass an array of some data type as a parameter. The language also has an easy-to-use function that will create an array on-the-fly. Since the Array() function accepts many different data types, it produces a Variant array.
可以传递某种数据类型的数组作为参数。 该语言还具有易于使用的功能,可以即时创建数组。 由于Array()函数接受许多不同的数据类型,因此会生成Variant数组。
http://www.cpearson.com/excel/VBAArrays.htm http://www.cpearson.com/excel/VBAArrays.htmHere is an example of an array of multi-character delimiters that we can pass into the parsing function.
这是我们可以传递给解析函数的多字符定界符数组的示例。
Array("<a ", "</a>", "img src=", "href=", _
"<form ", "</form>")
Incremental array building
增量阵列构建
Populating an array can be tricky. Firstly, you need to have enough empty slots to contain the new entries. If you are lucky enough to know how many entries you will add, then this process is fairly simple and efficient: just ReDim the array. However, you may need to add additional items. You do this by a ReDim of the array using the Preserve option to increase its size and then copy more items to the array.
填充数组可能很棘手。 首先,您需要有足够的空插槽来包含新条目。 如果您很幸运地知道要添加多少个条目,那么此过程将非常简单且高效:只需重新定义数组即可。 但是,您可能需要添加其他项目。 您可以使用“保留”选项通过阵列的ReDim来增加其大小,然后将更多项目复制到阵列中。
Note: The ReDim Preserve operation is a poor performer due to the underlying memory management and data copying operations. It is better to allocate a larger array than you might need and then trim the size of the array with a final ReDim Preserve operation.
注意:由于底层的内存管理和数据复制操作,ReDim Preserve操作的性能较差。 最好分配比您可能需要的更大的阵列,然后使用最后的ReDim Preserve操作修剪阵列的大小。
It is also possible to add new items using the intrinsic VB Split() and Join() functions.
也可以使用内部VB Split()和Join()函数添加新项目。
Dim Delims() As Variant
Delims = Array("<a ", "</a>")
Delims = Split(Join(Delims,"^") & "^" & "img src=" & "^" & "href=","^")
Delims = Split(Join(Delims,"^") & "^" & "<form " & "^" & "</form>", "^")
'To see the contents of Delims, run the following:
Dim D As Long
For D = 0 To UBound(Delims)
Debug.Print D, Delims(D)
Next
Note: The iterative Split() and Join() operations is a poor performer for the same reasons as iterative ReDim Preserve operations.
注意:由于与ReDim Preserve迭代操作相同的原因,迭代Split()和Join()操作的性能较差。
More Complex array data
更复杂的数组数据
With the Array() function it is possible to pass multi-dimensional arrays and arrays containing mixed data types. In this code snippet, the first item in each row is a numeric data type, the second item a string data type, and the third a date data type.
使用Array()函数可以传递多维数组和包含混合数据类型的数组。 在此代码段中,每行的第一项是数字数据类型,第二项是字符串数据类型,第三项是日期数据类型。
Dim Ex() As Variant
Ex = Array(Array(1,"Mark",#2/3/2009#), Array(2,"Fred",#3/4/2009#))
'To see the contents of Ex, run the following:
Dim D As Long
For D = 0 To UBound(Ex)
Debug.Print D, Ex(D)(0) , Ex(D)(1) , Ex(D)(2)
Next
Let's enhance our custom parsing function. Since the Replace() function also has both count and compare parameters, we can use these in our existing function.
让我们增强自定义解析功能。 由于Replace()函数还具有计数和比较参数,因此我们可以在现有函数中使用它们。
Note: It is possible to accomplish our parsing with iterative Split/Join operations, but this function pair isn't as efficient as iterative Replace operations.
注意:可以使用迭代的“拆分/合并”操作来完成我们的解析,但是此功能对不如迭代的“替换”操作有效。
'=======================================================
'ReplaceAndSplit3 is based on the alainbryden routine
'Uses the native REPLACE() function to replace all delimiters with a common
'delimiter, and then splits the modified string on that delimiter.
'=======================================================
Function ReplaceAndSplit3(ByRef parmText As String, _
parmDelimiters() As Variant) As String()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Expected format of parmDelimiters array:
' Each row contains three element array (indexes = 0,1,2)
' = delimstring, count, stringcomparetype
'Note: default count = -1 and the default stringcomparetype = 0
' See the Replace function documentation in the appendix for
' more information.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim DelimCount As Long, DelimLoop As Long
Dim strTemp As String
Dim Delim1() As Variant
Dim ThisDelim() As Variant
strTemp = parmText
Delim1 = parmDelimiters(0)
DelimCount = UBound(parmDelimiters)
For DelimLoop = 1 To DelimCount
ThisDelim = parmDelimiters(DelimLoop)
If InStr(strTemp, ThisDelim(0)) <> 0 Then _
strTemp = Replace(strTemp, ThisDelim(0), Delim1(0), 1, ThisDelim(1), ThisDelim(2))
Next DelimLoop
ReplaceAndSplit3 = Split(strTemp, Delim1(0), Delim1(1), Delim1(2))
End Function
Usage: If we wanted to parse a web page into the header and the first 5 name anchors, we might invoke this routine with:
用法:如果我们想将网页解析为标题和前5个名称锚点,则可以使用以下代码调用此例程:
Dim strHTML() As String
strHTML = ReplaceAndSplit3(strPageContents, _
Array(Array("<head>", -1, 0), Array("</head>", -1, 0), _
Array("<a name=", 5, 0)))
We are now going to drop the criterion that we might construct the list on the statement that we pass the parameter. All of the following methods are better suited for situations where you build the list of parameters through iteration or from some external source.
现在,我们将删除可能在传递参数的语句上构造列表的标准。 以下所有方法都更适合您通过迭代或从某些外部源构建参数列表的情况。
4.传递一个Collection或Dictionary对象 (4. Pass a Collection or Dictionary object)
集合和字典对象结合了添加新项目时链表的速度和关联项目访问的强度。 关联项目访问意味着您可以命名条目-将每个项目与(字符串值)键相关联。 除了键值访问之外,还可以使用数字(索引)值访问项,例如数组项。Some Background on Collection and Dictionary objects
集合和字典对象的一些背景
Collections are an intrinsic VB data type. As such, you do not have to add any references to your project. You have two choices when defining these objects in your code -- early binding and late binding. With early binding, the object variables exhibit Intellisense, where the properties and methods appear in a dropdown list when you type a period following the variable name.
集合是固有的VB数据类型。 这样,您不必向项目添加任何引用。 在代码中定义这些对象时,有两种选择-早期绑定和后期绑定。 使用早期绑定,对象变量将显示Intellisense,在变量名称后键入句点时,属性和方法将显示在下拉列表中。
Dim colEarlyBind As New Collection
Dim colLateBind As Collection
Set colLateBind = New Collection
Adding items to a collection object. For collections, the item data is the first parameter and the optional key value is the second parameter.
将项目添加到集合对象。 对于集合,项目数据是第一个参数,可选键值是第二个参数。
Dim colEarlyBind As New Collection
colEarlyBind.Add "<a "
colEarlyBind.Add "</a>"
colEarlyBind.Add "img src="
colEarlyBind.Add "href="
colEarlyBind.Add "<form "
colEarlyBind.Add "</form>"
Dictionary objects are part of the Microsoft Scripting Runtime. If you want the developer advantages of early binding, you will need to add a reference to the Microsoft Scripting Runtime library to your project.
字典对象是Microsoft脚本运行时的一部分。 如果您希望开发人员具有早期绑定的优势,则需要在项目中添加对Microsoft脚本运行时库的引用。
Dim dicEarlyBind As New Scripting.Dictionary
Dim dicLateBind As Object
Set dicLateBind = CreateObject("Scripting.Dictionary")
Adding items to a dictionary object. For dictionary objects, the key is the first parameter and the item data is the second parameter.
将项目添加到字典对象。 对于字典对象,键是第一个参数,项目数据是第二个参数。
Dim dicEarlyBind As New Scripting.Dictionary
dicEarlyBind.Add 1,"<a "
dicEarlyBind.Add 2,"</a>"
dicEarlyBind.Add 3,"img src="
dicEarlyBind.Add 4,"href="
dicEarlyBind.Add 5,"<form "
dicEarlyBind.Add 6,"</form>"
Col/Dic example function 1
Col / Dic示例功能1
This example is actually a step backwards. This example implements an equivalent functionality as ReplaceAndSplit2().
这个例子实际上是倒退的一步。 本示例实现了与ReplaceAndSplit2()等效的功能。
'=======================================================
'ReplaceAndSplit4 is based on the alainbryden routine
'Uses the native REPLACE() function to replace all delimiters with a common
'delimiter, and then splits the modified string on that delimiter.
'=======================================================
Function ReplaceAndSplit4(ByRef parmText As String, _
parmDelimiters As Variant) As String()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'parmDelimiters is expected to be a collection or dictionary.
'Note: Since the default item is iterated by the For Each statement
' below, the dictionary delimiters should be assigned to the
' key values since those are the default items.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strTemp As String
Dim Delim1 As Variant
Dim ThisDelim As Variant
strTemp = parmText
For Each ThisDelim In parmDelimiters
If IsEmpty(Delim1) Then
Delim1 = ThisDelim
Else
If InStr(strTemp, ThisDelim) <> 0 Then _
strTemp = Replace(strTemp, ThisDelim, Delim1)
End If
Next
ReplaceAndSplit4 = Split(strTemp, Delim1)
End Function
Usage: If we wanted to parse SQL query Where clause, we might invoke this routine with:
用法:如果我们想解析SQL查询Where子句,则可以使用以下代码调用此例程:
Dim dicDelim As New Scripting.Dictionary
Dim strParsed() As String
dicDelim.Add "(", 1
dicDelim.Add ")", 1
strParsed = ReplaceAndSplit4("WHERE (HireDate Between #4/1/2000# And #4/1/2009#) And (Cat Like 'PROD*')", dicDelim)
Dic example function 2
骰子示例功能2
Even though a collection item can have a key value associated with it, there is no way to retrieve the key values, just retrieve an item value by supplying the key value. However, the dictionary object exposes both the items and they keys. Think about these two sets of data as name=value pairs. This is an example that uses the key value as the recordset field name and the item value as the new field value.
即使收集项目可以具有与其关联的键值,也无法检索键值,仅通过提供键值来检索项目值。 但是,字典对象同时公开了各项及其键。 将这两组数据视为“名称=值”对。 此示例使用键值作为记录集字段名称,并使用项目值作为新字段值。
'=======================================================
'UpdateRecord accepts key/item (field name/value) pairs through
' a dictionary parameter, a recordset, and key value.
'=======================================================
Function UpdateRecord(parmRS As Recordset, _
parmID As Long _
parmNewValues As Variant) As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'parmRS is a recordset
'parmID is the ID (autonumber) value
'parmNewValues is expected to be a dictionary
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim vFieldname As Variant
Dim lngError As Long
On Error Resume Next
parmRS.Find "ID=" & parmID
parmRS.Edit
For Each vFieldname In parmNewValues
parmRS.Fields(vFieldname) = parmNewValues(vFieldname)
If Err <> 0 Then
lngError = Err
Exit For
End If
Next
If lngError = 0 Then
parmRS.Update
Else
parmRS.CancelUpdate
End If
UpdateRecord = lngError 'Return any error value
End Function
Usage: In this scenario, we have detected user changes to a row (in a non-bound control), saving the new values for each changed field in a dictionary object (key=field name). Now we update the recordset with the function:
用法:在这种情况下,我们检测到用户对行的更改(在非绑定控件中),将每个更改的字段的新值保存在字典对象(键=字段名)中。 现在,我们使用以下功能更新记录集:
Dim dicDataChgs As New Scripting.Dictionary
Dim lngRC As Long
dicDataChgs.Add "VisitDate", #4/1/2008#
dicDataChgs.Add "AgeAtEncounter", 55
dicDataChgs.Add "CD4Count", 780
dicDataChgs.Add "ARTname", "Kaletra"
dicDataChgs.Add "HemoFactorType", Null
lngRC = UpdateRecord(rsClinData, 2525, dicDataChgs)
Col/Dic example function 3
Col / Dic示例功能3
We can expand the prior function to update multiple rows. To accomplish this we will save the field value change dictionary object inside another dictionary object with the key being the row's ID value. Since there may be multiple rows updated, we will return multiple error codes, one for each attempted row update.
我们可以扩展先前的功能来更新多行。 为此,我们将字段值更改字典对象保存在另一个字典对象中,其键为行的ID值。 由于可能会更新多行,因此我们将返回多个错误代码,每次尝试更新行都会返回一个。
'=======================================================
'UpdateRecords accepts key/item (field name/value) pairs through
' a dictionary parameter, and a recordset.
'=======================================================
Function UpdateRecords(parmRS As Recordset, _
parmNewValues As Variant) As Collection
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'parmRS is a recordset
'parmNewValues is expected to be a dictionary of dictionary objects.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim vFieldname As Variant
Dim vRow As Variant
Dim lngError As Long
Dim colErrors As New Collection
On Error Resume Next
For Each vRow In parmNewValues
parmRS.Find "ID=" & vRow
parmRS.Edit
For Each vFieldname In parmNewValues(vRow)
parmRS.Fields(vFieldname) = parmNewValues(vRow)(vFieldname)
If Err <> 0 Then
lngError = Err
Exit For
End If
Next
If lngError = 0 Then
parmRS.Update
Else
parmRS.CancelUpdate
End If
colErrors.Add CStr(lngError) 'Return any error values
Next 'Row change
Set UpdateRecords = colErrors
End Function
Usage: In this scenario, we have detected user changes to two rows (in a non-bound control), saving the new values for each changed field in a dictionary object (key=field name). Now we update the recordset with the multi-row change function:
用法:在这种情况下,我们检测到用户更改为两行(在非绑定控件中),将每个更改的字段的新值保存在字典对象(键=字段名称)中。 现在,我们使用多行更改功能更新记录集:
Dim dicDataChgs As New Scripting.Dictionary
Dim dicRowChgs As New Scripting.Dictionary
Dim colErrors As New Collection
dicDataChgs.Add "VisitDate", #4/1/2008#
dicDataChgs.Add "AgeAtEncounter", 55
dicDataChgs.Add "CD4Count", 780
dicDataChgs.Add "ARTname", "Kaletra"
dicDataChgs.Add "HemoFactorType", Null
dicRowChgs.Add 2525, dicDataChgs
Set dicDataChgs = New Scripting.Dictionary 'new instance
dicDataChgs.Add "VisitDate", #5/15/2008#
dicDataChgs.Add "AgeAtEncounter", 19
dicDataChgs.Add "HemoFactorType", "VIII"
dicRowChgs.Add 42, dicDataChgs
Set colErrors = UpdateRecords(rsClinData, dicRowChgs)
Using class objects
使用类对象
In our last example, we passed multiple dictionary objects, stored inside a dictionary object 'wrapper'. However, you are much more likely to see multiple complex objects stored rather than multiple dictionary objects stored. Since we can create own class objects, we can go far beyond the simple key/item pair data we've used in the dictionary object examples above. We would still use a collection or dictionary object to contain multiple instances of our class object, providing us with the ability to pass these to a function through a single parameter.
在最后一个示例中,我们传递了多个字典对象,这些对象存储在字典对象“包装器”中。 但是,您更有可能看到存储了多个复杂对象,而不是存储了多个字典对象。 由于我们可以创建自己的类对象,因此我们可以超出上面的字典对象示例中使用的简单键/项对数据。 我们仍将使用集合或字典对象来包含类对象的多个实例,从而使我们能够通过单个参数将这些实例传递给函数。
If you are unfamiliar with using class objects, think about creating your own single-row recordset object. You add a Class module to your project and click on the Insert | Procedure menu, you will see that the procedure type options include PROPERTY. Class properties are most similar to recordset fields, they have a data type and a value.
如果您不熟悉使用类对象,请考虑创建自己的单行记录集对象。 您将一个Class模块添加到您的项目中,然后单击Insert | 在过程菜单中,您将看到过程类型选项包括PROPERTY。 类属性与记录集字段最相似,它们具有数据类型和值。
The coverage of class creation and usage will be the central theme of a subsequent article.
类创建和使用的内容将是后续文章的主题。
Class object example
类对象示例
Behind the scenes in the following example is a class with two properties (Action, Value, NewValue). We are going to pass a collection of these class objects to a routine that effects the Actions.
下面的示例在幕后是一个具有两个属性(Action,Value,NewValue)的类。 我们将把这些类对象的集合传递给影响Action的例程。
'=======================================================
'FileActions performs actions on files
'=======================================================
Function FileActions(parmActions As Collection) As Collection
Dim clsAction As MyActionClass
Dim colErrors As New Collection
On Error Resume Next
For Each clsAction In parmActions
Select Case clsAction.Action
Case ActionEnums.Copy
FileCopy clsAction.Value, clsAction.NewValue
Case ActionEnums.Delete
Kill clsAction.Value
Case ActionEnums.Move
FileCopy clsAction.Value, clsAction.NewValue
Kill clsAction.Value
Case ActionEnums.Rename
Name clsAction.Value As clsAction.NewValue
End Select
colErrors.Add CStr(Err) 'Return any error values
If Err <> 0 Then
Err.Clear
End If
Next
Set FileActions = colErrors
End Function
Usage: In this scenario, I create three class objects to rename, copy and delete some files. I've done something similar in one of my commercial applications. I might need to send an encrypted file to a user to correct some application or licensing problem. After decrypting the file, I process the individual actions supplied. In this example, the actions and other properties are being set from literals instead of from an external source.
用法:在这种情况下,我创建了三个类对象以重命名,复制和删除一些文件。 我在一项商业应用程序中做了类似的事情。 我可能需要将加密的文件发送给用户,以更正某些应用程序或许可问题。 解密文件后,我将处理提供的各个操作。 在此示例中,操作和其他属性是从文字而不是从外部源设置的。
Dim clsX As MyActionClass
Dim colActions As New Collection
Dim colErrors As New Collection
Dim vError As Variant
Set clsX = New MyActionClass
With clsX
.Action = Rename
.Value = "C:\Temp\Old.txt"
.NewValue = "C:\Temp\New.txt"
End With
colActions.Add clsX
Set clsX = Nothing
Set clsX = New MyActionClass
With clsX
.Action = Copy
.Value = "C:\Temp\New.txt"
.NewValue = "C:\Temp2\NewCopy.txt"
End With
colActions.Add clsX
Set clsX = Nothing
Set clsX = New MyActionClass
With clsX
.Action = Delete
.Value = "C:\Temp\New.txt"
End With
colActions.Add clsX
Set colErrors = FileActions(colActions)
'Display the error collection in the Immediate window
For Each vError In colErrors
Debug.Print vError, Error(vError)
Next
Option Explicit
Public Enum ActionEnums
Rename = 1
Delete = 2
Copy = 4
Move = 8
End Enum
Public Action As ActionEnums
Private strValue As String
Private strNewValue As String
Public Property Get Value() As Variant
Value = strValue
End Property
Public Property Let Value(ByVal vNewValue As Variant)
strValue = vNewValue
End Property
Public Property Get NewValue() As Variant
NewValue = strNewValue
End Property
Public Property Let NewValue(ByVal vNewValue As Variant)
strNewValue = vNewValue
End Property
5.传递XMLDocument (5. Pass an XMLDocument)
像对象一样,XML文件和字符串也能够存储非常复杂的数据,包括项目列表。 您将需要将引用加载到MSXML库。 (早期绑定),以使此代码按书面形式工作。 在这个简单的示例中,XML文件包含一些与房屋相关的数据。 ListNodes代码遍历节点,并在“即时”窗口中打印内容的格式化版本。Sub ListNodes(parmXMLdoc As DOMDocument)
Dim xElement As IXMLDOMElement
Dim xElement2 As IXMLDOMElement
For Each xElement In parmXMLdoc.childNodes(1).childNodes
Debug.Print xElement.getAttribute("Name")
For Each xElement2 In xElement.childNodes
Debug.Print , xElement2.nodeName, xElement2.Text
Next
Debug.Print "__________________"
Next
End Sub
Usage: I initialize a variable with the contents of an XML file and then pass that variable to the ListNodes subroutine.
用法:我使用XML文件的内容初始化变量,然后将该变量传递给ListNodes子例程。
Dim xDoc As New DOMDocument
xDoc.Load "C:\Users\AikiMark\Documents\test.xml"
ListNodes xDoc
<?xml version="1.0" encoding="utf-8"?>
<Houses>
<House Name="Mark">
<Color>Carolina Blue</Color>
<Addr>14 Flagon O Mead Ct</Addr>
<City>Durham</City>
<State>NC</State>
<Zip>27714</Zip>
</House>
<House Name="Fred">
<Color>Red Brick</Color>
<Addr>2610 Flintstone Blvd</Addr>
<City>Tullahoma</City>
<State>TN</State>
<Zip>98898</Zip>
</House>
</Houses>
6.结论和建议 (6. Conclusions and Recommendations)
可以通过单个参数传递长而复杂的项目列表。 您应该使用满足您需求的简单方案。 集合和字典对象的优点是,在将它们存储在数据结构中之前,您不必知道要拥有多少个项目。7.参考和其他 (7. References and Extras)
Excel example function -- unique values
Excel示例函数-唯一值
I want to leave this nugget for the Excel-centric readers. There are many times when you need to eliminate the duplicate values from a range. Like we did with the two UpdateRecord(s) examples, we can return a collection or dictionary object. In this case, the Excel user will be prompted for a range containing duplicate values and prompted for a starting point into which to start placing unique values.
我想把这个话题留给以Excel为中心的读者。 很多时候,您需要从范围中消除重复的值。 就像我们对两个UpdateRecord(s)示例所做的那样,我们可以返回集合或字典对象。 在这种情况下,将提示Excel用户输入包含重复值的范围,并提示您开始将唯一值放入其中的起点。
Note: I am using the Appliction.InputBox() function instead of the VB InputBox() function, since I can specify the acceptable data type.
注意:因为我可以指定可接受的数据类型,所以我使用的是Appliction.InputBox()函数而不是VB InputBox()函数。
Public Sub UniqueValues()
Dim rngOriginal As Range
Dim rngUnique As Range
Dim dicUniqueValues As Scripting.Dictionary
Dim vUnique As Variant
Dim lngOffset As Long
Const cIBtype_Range As Long = 8
Set rngOriginal = Application.InputBox("Select range of values", _
"Range Prompt", Type:=cIBtype_Range)
Set rngUnique = Application.InputBox("Select starting location for unique values", _
"Unique Start Prompt", Type:=cIBtype_Range)
Set dicUniqueValues = GetUniqueValues(rngOriginal)
Application.
Application.ScreenUpdating = False 'for better performance
For Each vUnique In dicUniqueValues
rngUnique.Offset(lngOffset, 0) = vUnique
lngOffset = lngOffset + 1
Next
Application.ScreenUpdating = True
End Sub
Public Function GetUniqueValues(parmRng As Range) As Scripting.Dictionary
Dim dicUnique As New Scripting.Dictionary
Dim rngCell As Range
For Each rngCell In parmRng
If dicUnique.Exists(rngCell.Value) Then
Else
dicUnique.Add rngCell.Value, 1
End If
Next
Set GetUniqueValues = dicUnique
Set dicUnique = Nothing
End Function
Really Fast version: If you have a large set of unique values, you might also benefit from this trick. Since dictionary keys will automatically be exposed as an array, we can assign these values to an array variable. Once in an array variable, we can use the Transpose worksheet function to copy all the unique values into the worksheet in one operation.
真正快速的版本:如果您有大量的唯一值,则可能还会从此技巧中受益。 由于字典键将自动显示为数组,因此我们可以将这些值分配给数组变量。 放入数组变量后,我们可以使用“转置”工作表功能通过一次操作将所有唯一值复制到工作表中。
Public Sub UniqueValuesFast()
Dim rngOriginal As Range
Dim rngUnique As Range
Dim vArray() As Variant
Const cIBtype_Range As Long = 8
Set rngOriginal = Application.InputBox("Select range of values", _
"Range Prompt", Type:=cIBtype_Range)
Set rngUnique = Application.InputBox("Select starting location for unique values", _
"Unique Start Prompt", Type:=cIBtype_Range)
vArray = GetUniqueValues(rngOriginal).Keys
Application.ScreenUpdating = False 'for better performance
rngUnique.Worksheet.Range(rngUnique.Address, rngUnique.Offset(UBound(vArray), 0)) = _
Application.WorksheetFunction.Transpose(vArray)
Application.ScreenUpdating = True
End Sub
Replace function
替换功能
Replace(String, Findstring, Replacewith [,Start[,Count[,Compare]]]
替换(字符串,查找字符串,替换为[,开始[,计数[,比较]]] )
Parameter Description
String The string to be searched
Findstring The searched-for string -- will be replaced
Replacewith The replacement string
Start Optional. Specifies the start position -- Default = 1
Count Optional. Specifies the number of substitutions to perform. The default value is -1, which causes replacement of all the Findstring values
Compare Optional. Specifies the type of comparison to use, case-sensitive or case-insensitive. The default is 0 (case sensitive) which performs faster.
Can be one of the following values:
0 = vbBinaryCompare - Perform a binary comparison
1 = vbTextCompare
cxf传递复杂参数