VBA - array or collection literals?

[Marcus =?iso-8859-15?Q?Sch=F6neborn?=]

Currently, I have written a function to do some sort of pattern
matching:

Dim delims As New Collection
delims.Add " <"
delims.Add "@"
delims.Add ">"

Dim tokens As Collection
tokens = UnDelimit("Marcus Schöneborn <[email protected]>", delims)
? tokens.Count ' 4
? tokens(1) ' "Marcus Schöneborn"
? tokens(2) ' "divZero"
? tokens(3) ' "googlemail.com"
? tokens(4) ' ""

Is there a simpler way to call this by making a "literal" collection,
think of it like

Dim tokens As Collection
tokens = UnDelimit("...", {" <", "@", ">"})

Or is there a way to get C-like function varargs, so I can use it like

Dim tokens As Collection
tokens = UnDelimit("...", " <", "@", ">")

Or, alternatively: is there a way to make the VBScript.RegExp object
support . matching newlines?

 

[Chip Pearson]

Marcus,

Here's some code from my standard library that will do what you want, if I
understand your question properly:


Function SplitMultiDelims(Text As String, DelimChars As String) As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMutliChar
' Works list SPLIT but supports multiple delimiter characters, which
' together make up the string DelimChars. Text is the text to split
' apart using the characters of DelimChars. Returns an array of the
' split works of Text. Supports only single character delimiters.
' See SplitMutliDelimsEX for multi-character delimiters.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long

' if Text is empty, get out
If Len(Text) = 0 Then
Exit Function
End If


' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = Pos1 To Len(Text)
For M = 1 To Len(DelimChars)
If StrComp(Mid(Text, N, 1), Mid(DelimChars, M, 1), vbTextCompare) =
0 Then
I = I + 1
Arr(I) = Mid(Text, Pos1, N - Pos1)
Pos1 = N + 1
N = N + 1
End If
Next M
Next N

If Pos1 <= Len(Text) Then
I = I + 1
Arr(I) = Mid(Text, Pos1)
End If


' chop off unused array elements
ReDim Preserve Arr(1 To I)
SplitMultiDelims = Arr

End Function

Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns True or False indicating whether a dynamic
' array is allocated. It supports arrays that are the
' result of functions like Split in which case the
' LBound is greater than the UBound for unallocated
' arrays.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
IsArrayAllocated = (IsArray(Arr) = True) And _
(IsError(LBound(Arr, 1)) = False) And _
(LBound(Arr, 1) <= (UBound(Arr, 1)))

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
You can then test the code with

Sub AAAA()

Const C_DELIM_CHARS = "|:,;" ' for example
Dim Arr() As String
Dim S As String
Dim N As Long

S = "a|bc;def:ghij;klmno|"

Arr = SplitMultiDelims(Text:=S, DelimChars:=C_DELIM_CHARS)
If IsArrayAllocated(Arr) = True Then
For N = LBound(Arr) To UBound(Arr)
Debug.Print Arr(N)
Next N
End If

End Sub

The C_DELIM_CHARS contants should contain all the characters you want to use
a delimiters, and nothing else (e.g., the delimiters aren't themselves
delimited).


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)

 

[Marcus =?iso-8859-15?Q?Sch=F6neborn?=]

Marcus,

Here's some code from my standard library that will do what you want, if I
understand your question properly:

You didn't, but I found a way in fact.

"ParamArray Delimiters() As Variant" is the trick...

then I can just specify the different delimiters in the function call.
Also...

Function MakeArray(ParamArray arr() As Variant) As Variant()
MakeArray = arr
End Function

looks like a useful utility function. Is there a conversion the other
way round, like "apply" in many languages? Think of it like this:

Dim args(3) As Variant
args(1) = "Hello World"
args(2) = 4
args(3) = 2
result = Apply(Mid, args)
' result is now "lo"

In other words, what I am looking for is a function with the property:

For each argument list ... and each function f,

f(...) = Apply(f, MakeArray(...))

hold.

From this, we can conclude:

Apply(MakeArray, somelist)
= Apply(MakeArray, MakeArray(items in somelist separated by comma))
= MakeArray(items in somelist separated by comma)
= somelist

so the other inversion does not need to be specified too.


Actually, what I originally wanted to have is a simpler regex-like way
to extract data out of strings, like:

Dim s As String
s = UnDelimit(htmlpage, ">Number of items:<", "<td>", "</td>")(3)

Let htmlpage then be "...<th>Number if items:</th><td>42</td>...", then
UnDelimit would return the following list:

MakeArray("...<th", "/th>", "42", "...")

Think of it as an equivalent to Perl's

my $s = ($htmlpage =~ m!^.*?>Number of items:<.*?<td>(.*?)</td>.*$!);

Of course, the initial and final ^.*? or .*$ can be left out as they are
implicitly given in Perl REs. It's actually a simple function based on a
series of InStr.