Another Parsing question 1

[timhans]

Hello,in a earlier thread PHV provided succinct parsing function for a single delimiter of choice but at time's I have need for a multi parsing function. Found the following code which parse's with multiple delimiters, can not get it to work, not sure I am calling it correctly, in query
builder

Parse([Location],) or variations on this, where Location is the sole field in a table, was posted on a Vb website((

http://www.freevbcode.com/ShowCode.Asp?ID=3208).

Any insight in how to use or retro fit to access is appreciated, thanks

Public Function Parse(ByVal inString, Optional ByVal delimiters)
'Take a string, and return it as a one dimensional array
' of individual values as delimited by any of several
' characters. None of those characters are returned in
' the result. Provide a default list of delimiters, which
' should come from registry. But allow override.
Dim delimitList, oneChar, aWord, codeCount
Dim arrayCodes()

If IsMissing(delimiters) Then
'We should get these from Registry
delimitList = " ,/!| "
'Characters recognized as delimiters

Else
delimitList = delimiters
'user can override if needed
End If
Dim i, j, k
i = Len(inString)
For j = 1 To i
'Read one character at a time

oneChar = VBA.Strings.Mid(inString, j, 1)
k = InStr(delimitList, oneChar)
'Is this one a delimiter?
If k = 0 Then
aWord = aWord & oneChar
'If is isn't, add to the current word
End If
If k <> 0 Or j = i Then
'If it is, or if we're finished
If aWord > "" Then
codeCount = codeCount + 1
ReDim Preserve arrayCodes(codeCount)
arrayCodes(codeCount) = aWord
'Save new word
aWord = ""
End If
End If
Next j
Parse = arrayCodes
'Return the array
End Function

 

[PHV]

The Function you posted return an array and you can't use use arrays in SQL ...
What about this ?

Function GetCSWord(ByVal S, Indx As Integer, Delimiters As String)
If IsNull(S) Then Exit Function
Dim myArr, i As Long, c As String
c = Left(Delimiters, 1)
For i = 2 To Len(Delimiters)
  S = Replace(S, Mid(Delimiters, i, 1), c)
Next
myArr = Split(S, c)
If Indx >= 1 And Indx <= (1 + UBound(myArr)) Then
  GetCSWord3 = Trim(myArr(Indx - 1))
End If
End Function

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[timhans]

PHV, succinct, marvelous code as always, much appreciated

 

[PHV]

Er, well, small typo:
GetCSWord = Trim(myArr(Indx - 1))

 

[timhans]

I caught that!, all on my own, I must be learning something, Thanks again

 

[timhans]

PHV, one problem, if say you have a name Smith, Joe (two delimiters next to one another)and parse

want to get
smith joe
but get
smith joe
it skips a field, have tried altering your code but no luck

 

[PHV]

Function GetCSWord(ByVal S, Indx As Integer, Delimiters As String, Optional Consecutive As Boolean = False)
If IsNull(S) Then Exit Function
Dim myArr, i As Long, c As String
c = Left(Delimiters, 1)
For i = 2 To Len(Delimiters)
  S = Replace(S, Mid(Delimiters, i, 1), c)
Next
If Consecutive Then
  While InStr(S, c & c): S = Replace(S, c & c, c): Wend
End If
myArr = Split(S, c)
If Indx >= 1 And Indx <= (1 + UBound(myArr)) Then
  GetCSWord = Trim(myArr(Indx - 1))
End If
End Function

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[timhans]

PHV, works very well no matter how many delimiters are next to one another. Thanks again, this will be helpful for years to come and I never could have done it on my own. Tim

For anyone else using this please make the following change

Optional Consecutive As Boolean = False
Changed to
Optional Consecutive As Boolean = True