Const strLeft As String = "{"
Const strRight As String = "}"
Const strPipe As String = "|"
Function Interpret(ByVal aString As String, Optional PipeMode As Boolean) As Variant
Dim i As Long
Dim Result() As String, Pointer As Long
Dim Elements As Variant, oneElement As Variant, oneString As Variant
Dim ElementResults As Variant, oneResult As Variant, elementCount As Long
Dim ElementIndexes() As Long
Dim thisResult As Variant, thisSubString As String
Dim IndexPointer As Long, IndexFlag As Boolean
Dim temp
ReDim Result(0 To 0): Pointer = -1
If PipeMode Then
Elements = ParseString(aString, "|")
For Each oneElement In Elements
For Each oneResult In Interpret(oneElement)
Pointer = Pointer + 1
If UBound(Result) < Pointer Then ReDim Preserve Result(0 To 2 * Pointer)
Result(Pointer) = oneResult
Next oneResult
Next oneElement
Else
Elements = ParseString(aString)
If (UBound(Elements) = 0) And aString Like ("{*}") Then
temp = Mid(aString, 2, Len(aString) - 2)
Result = Interpret(temp, True)
Pointer = UBound(Result)
ElseIf aString Like "*{*}*" Then
elementCount = UBound(Elements)
ReDim ElementResults(0 To elementCount)
For i = 0 To elementCount
ElementResults(i) = Interpret(CStr(Elements(i)))
Next i
ReDim ElementIndexes(0 To elementCount)
Do
Pointer = Pointer + 1
If UBound(Result) < Pointer Then ReDim Preserve Result(0 To 2 * Pointer)
For i = 0 To elementCount
thisResult = ElementResults(i)
thisSubString = thisResult(ElementIndexes(i))
Result(Pointer) = Result(Pointer) & thisSubString
Next i
Rem incriment indexees
IndexPointer = elementCount
Do
IndexFlag = False
ElementIndexes(IndexPointer) = ElementIndexes(IndexPointer) + 1
If ElementIndexes(IndexPointer) > UBound(ElementResults(IndexPointer)) Then
ElementIndexes(IndexPointer) = 0
IndexPointer = IndexPointer - 1
IndexFlag = True
If IndexPointer < 0 Then Exit Do
End If
Loop While IndexFlag
IndexFlag = (IndexPointer < 0)
Loop Until IndexFlag
Else
Rem aString is single string
Pointer = 0
Result(Pointer) = aString
End If
End If
ReDim Preserve Result(0 To Pointer)
Interpret = Result
End Function
Function ParseString(aString As String, Optional onDelimiter As String = "{") As Variant
Dim BracketCount As Long
Dim thisChr As String
Dim i As Long
Dim Result() As String, Pointer As Long
ReDim Result(0 To Len(aString))
Pointer = 0
If onDelimiter = strLeft Then
For i = 1 To Len(aString)
thisChr = Mid(aString, i, 1)
If thisChr = strLeft Then
If 0 = BracketCount Then
Rem end previous
Pointer = Pointer + Sgn(Len(Result(Pointer)))
End If
Result(Pointer) = Result(Pointer) & thisChr
BracketCount = BracketCount + 1
ElseIf thisChr = strRight Then
BracketCount = BracketCount - 1
Result(Pointer) = Result(Pointer) & thisChr
If 0 = BracketCount Then
Rem end previous
Pointer = Pointer + Sgn(Len(Result(Pointer)))
End If
Else
Result(Pointer) = Result(Pointer) & thisChr
End If
Next i
If Result(Pointer) = vbNullString Then Pointer = Pointer - 1
If Pointer < 0 Then Pointer = 0
ReDim Preserve Result(0 To Pointer)
Else
For i = 1 To Len(aString)
thisChr = Mid(aString, i, 1)
If thisChr = strPipe And BracketCount = 0 Then
Pointer = Pointer + 1
ElseIf thisChr = strLeft Then
BracketCount = BracketCount + 1
Result(Pointer) = Result(Pointer) & thisChr
ElseIf thisChr = strRight Then
BracketCount = BracketCount - 1
Result(Pointer) = Result(Pointer) & thisChr
Else
Result(Pointer) = Result(Pointer) & thisChr
End If
Next i
ReDim Preserve Result(0 To Pointer)
End If
ParseString = Result
End Function
