if you have 'standardized' on a hyphen as your delimiter, here is some
general code that I use to parse a variety of formats
dim InpString as string
dim OutString as string
dim DelString as string
InpString = "cv-456"
DelString = "-"
OutString = funcGetTokens(InpString,DelString,2)
al
Public Function funcGetTokens(strTemp As String, strDelimiter As String,
lngIndex As Long) As String
' funcGetTokens is a general parser that the user supplies
' an input string, a delimiter (1 or more characters) and an index
' into the input string to get a subset of the string
' if csv we watch for parens (i.e. embedded lists)
Dim lngTokenCount As Long
Dim lngCount As Long
Dim lngTempPos As Long
Dim lngSPos As Long
Dim lngEPos As Long
Dim intLenDel As Integer
Dim boolEmbeddedList As Boolean
Dim intListStart As Integer
Dim intListStop As Integer
Dim boolCSV As Boolean
' is this a csv parse ?
If strDelimiter = "," Then
boolCSV = True
Else
boolCSV = False
End If
intListStart = InStr(1, strTemp, "(", vbBinaryCompare)
intListStop = InStr(1, strTemp, ")", vbBinaryCompare)
If intListStop > intListStart Then
boolEmbeddedList = True
Else
boolEmbeddedList = False
End If
lngTokenCount = funcCountTokens(strTemp, strDelimiter)
If lngIndex < 1 Or lngIndex > lngTokenCount Then
funcGetTokens = 0
Exit Function
End If
intLenDel = Len(strDelimiter)
lngCount = 1
lngSPos = 1
If lngIndex = 1 Then
If boolCSV = True And boolEmbeddedList = True Then
' recheck where the list is from this spot
intListStart = InStr(1, strTemp, "(", vbBinaryCompare)
intListStop = InStr(1, strTemp, ")", vbBinaryCompare)
lngEPos = InStr(1, strTemp, strDelimiter) - intLenDel
' don't point into a list
If lngEPos < intListStart Then
funcGetTokens = Mid(strTemp, 1, lngEPos - 1 + intLenDel)
Exit Function
End If
Else
lngEPos = InStr(1, strTemp, strDelimiter) - intLenDel
funcGetTokens = Mid(strTemp, 1, lngEPos - 1 + intLenDel)
Exit Function
End If
End If
For lngCount = 2 To lngIndex
If boolCSV = True And boolEmbeddedList = True Then
' recheck where the list is from this spot
intListStart = InStr(lngSPos, strTemp, "(", vbBinaryCompare)
intListStop = InStr(lngSPos, strTemp, ")", vbBinaryCompare)
lngTempPos = InStr(lngSPos, strTemp, strDelimiter, 0) -
intLenDel
' don't point into a list
If lngTempPos < intListStart Or lngTempPos > intListStop
Then
lngSPos = lngTempPos
lngCount = lngCount + 1
End If
Else
lngSPos = InStr(lngSPos, strTemp, strDelimiter, 0) +
intLenDel
DoEvents
End If
Next lngCount
DoEvents
lngEPos = InStr(lngSPos, strTemp, strDelimiter, 0) - intLenDel
If lngEPos <= 0 Then
lngEPos = Len(strTemp)
End If
funcGetTokens = Mid(strTemp, lngSPos, lngEPos - lngSPos + intLenDel)
End Function
Public Function funcCountTokens(strTemp As String, strDelimiter As
String) As Long
'
' Counts strings separated by input string delimter
' if the delimiter is a comma then check for embedded lists
'
Dim lngTokenCount As Long
Dim lngIndex As Long
Dim lngTempIndex As Long
Dim lngDelLen As Long
Dim lngInput As Long
Dim boolEmbeddedList As Boolean
Dim intListStart As Integer
Dim intListStop As Integer
Dim boolCSV As Boolean
' is this a csv parse ?
If strDelimiter = "," Then
boolCSV = True
Else
boolCSV = False
End If
intListStart = InStr(1, strTemp, "(", vbBinaryCompare)
intListStop = InStr(1, strTemp, ")", vbBinaryCompare)
If intListStop > intListStart Then
boolEmbeddedList = True
Else
boolEmbeddedList = False
End If
lngInput = Len(strTemp)
If VarType(strTemp) <> vbString Or Len(strTemp) = 0 Then
funcCountTokens = 0
Exit Function
End If
lngDelLen = Len(strDelimiter)
' first check to see if there is a delimter in the string
lngIndex = InStr(strTemp, strDelimiter)
lngTokenCount = 1
Do While ((lngIndex > 0) And (lngIndex <= lngInput))
' since we got here we must have found a token
If boolCSV = True And boolEmbeddedList = True Then
' recheck where the list is from this spot
intListStart = InStr(1, strTemp, "(", vbBinaryCompare)
intListStop = InStr(1, strTemp, ")", vbBinaryCompare)
lngTempIndex = InStr(lngIndex + lngDelLen, strTemp,
strDelimiter, 0)
If lngTempIndex > intListStart Or lngTempIndex < intListStop
Then
lngTokenCount = lngTokenCount + 1
lngIndex = lngTempIndex
Else
lngIndex = lngIndex + 1
End If
Else
lngTokenCount = lngTokenCount + 1
lngIndex = InStr(lngIndex + lngDelLen, strTemp,
strDelimiter, 0)
End If
DoEvents
Loop
' suspect I need some logic for what happens if no delimter found
funcCountTokens = lngTokenCount
End Function
