Option Explicit
'===============================================
'Words.bas - string handling functions for words
'Author: Evan Sims [esims@arcola-il.com]
'Based on a module by Kevin O'Brien
'Version - 1.2 (Sept. 1996 - Dec 1999)
'
'These functions deal with "words".
'Words = blank-delimited strings
'Blank = any combination of one or more spaces,
' tabs, line feeds, or carriage returns.
'
'Examples:
' pword("find 3 in here", 3) = "in" 3rd word
' words("find 3 in here") = 4 number of words
' split("here's /s more", "/s") = "more" Returns words after split identifier (/s)
' delWord("find 3 in here", 1, 2) = "in here" delete 2 words, start at 1
' midWord("find 3 in here", 1, 2) = "find 3" return 2 words, start at 1
' wordPos("find 3 in here", "in") = 3 word-number of "in"
' wordCount("find 3 in here", "in") = 1 occurrences of word "in"
' wordIndex("find 3 in here", "in") = 8 position of "in"
' wordIndex("find 3 in here", 3) = 8 position of 3rd word
' wordIndex("find 3 in here", "3") = 6 position of "3"
'wordLength("find 3 in here", 3) = 2 length of 3rd word
'
'Difference between Instr() and wordIndex():
' InStr("find 3 in here", "in") = 2
' wordIndex("find 3 in here", "in") = 8
'
' InStr("find 3 in here", "her") = 11
' wordIndex("find 3 in here", "her") = 0
'===============================================
Public Function Pword(ByVal sSource As String, _
n As Long) As String
'=================================================
' Word retrieves the nth word from sSource
' Usage:
' Word("red blue green ", 2) "blue"
'=================================================
Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count
Dim lEnd As Long 'position of trailing word delimiter
sSource = CSpace(sSource)
'find the nth word
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = n Then 'the target word-number
lEnd = InStr(pointer, sSource, SP) 'pos of space at end of word
If lEnd = 0 Then lEnd = Len(sSource) + 1 ' or if its the last word
Pword = Mid$(sSource, pointer, lEnd - pointer)
Exit Do 'word found, done
End If
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1 'start of next word
Loop
End Function
Public Function Words(ByVal sSource As String) As Long
'=================================================
' Words returns the number of words in a string
' Usage:
' Words("red blue green") 3
'=================================================
Const SP As String = " "
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of Instr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count
sSource = CSpace(sSource)
lSource = Len(sSource)
If lSource = 0 Then Exit Function
'count words
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'no more words
x = x + 1 'increment word counter
pointer = pos + 1 'start of next word
Loop
If Mid$(sSource, lSource, 1) = SP Then x = x - 1 'adjust if trailing space
Words = x
End Function
Public Function WordCount(ByVal sSource As String, _
sTarget As String) As Long
'=====================================================
' WordCount returns the number of times that
' word, sTarget, is found in sSource.
' Usage:
' WordCount("a rose is a rose", "rose") 2
'=================================================
Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim lSource As Long 'length of sSource
Dim lTarget As Long 'length of sTarget
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count
lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)
'find target word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function 'sSource contains no words
Do 'find position of sTarget
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Do 'string not found
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then 'must be a word
If pos = 1 Then
x = x + 1 'word found
ElseIf Mid$(sSource, pos - 1, 1) = SP Then
x = x + 1 'word found
End If
End If
pointer = pos + lTarget
Loop
WordCount = x
End Function
Public Function WordPos(ByVal sSource As String, _
sTarget As String) As Long
'=====================================================
' WordPos returns the word number of the
' word, sTarget, in sSource.
' Usage:
' WordPos("red blue green", "blue") 2
'=================================================
Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim lSource As Long 'length of sSource
Dim lTarget As Long 'length of sTarget
Dim lPosTarget As Long 'position of target-word
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count
lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)
'find target word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function 'sSource contains no words
Do 'find position of sTarget
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Function 'string not found
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then 'must be a word
If pos = 1 Then Exit Do 'word found
If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
End If
pointer = pos + lTarget
Loop
'count words until position of sTarget
lPosTarget = pos 'save position of sTarget
pointer = 1
x = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer >= lPosTarget Then Exit Do 'all words have been counted
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'no more words
x = x + 1 'increment word count
pointer = pos + 1 'start of next word
Loop
WordPos = x
End Function
Public Function WordIndex(ByVal sSource As String, _
vTarget As Variant) As Long
'===========================================================
' WordIndex returns the byte position of vTarget in sSource.
' vTarget can be a word-number or a string.
' Usage:
' WordIndex("two plus 2 is four", 2) 5
' WordIndex("two plus 2 is four", "2") 10
' WordIndex("two plus 2 is four", "two") 1
'===========================================================
Const SP As String = " "
Dim sTarget As String 'vTarget converted to String
Dim lTarget As Long 'vTarget converted to Long, or length of sTarget
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of InStr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word counter
lSource = Len(sSource)
sSource = CSpace(sSource)
If VarType(vTarget) = vbString Then GoTo strIndex
If Not IsNumeric(vTarget) Then Exit Function
lTarget = CLng(vTarget) 'convert to Long
'find byte position of lTarget (word number)
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = lTarget Then 'word-number of Target
If pointer > lSource Then Exit Do 'beyond end of sSource
WordIndex = pointer 'position of word
Exit Do 'word found, done
End If
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1
Loop
Exit Function
strIndex:
sTarget = CStr(vTarget)
lTarget = Len(sTarget)
If lTarget = 0 Then Exit Function 'nothing to count
'find byte position of sTarget (string)
pointer = 1
Do
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Do
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then
If pos = 1 Then Exit Do
If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
End If
pointer = pos + lTarget
Loop
WordIndex = pos
End Function
Public Function WordLength(ByVal sSource As String, _
n As Long) As Long
'=========================================================
' Wordlength returns the length of the nth word in sSource
' Usage:
' WordLength("red blue green", 2) 4
'=========================================================
Const SP As String = " "
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter Instr()
Dim pos As Long 'position of target with InStr()
Dim x As Long 'word count
Dim lEnd As Long 'position of trailing word delimiter
sSource = CSpace(sSource)
lSource = Len(sSource)
'find the nth word
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = n Then 'the target word-number
lEnd = InStr(pointer, sSource, SP) 'pos of space at end of word
If lEnd = 0 Then lEnd = lSource + 1 ' or if its the last word
WordLength = lEnd - pointer
Exit Do 'word found, done
End If
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1 'start of next word
Loop
End Function
Public Function DelWord(ByVal sSource As String, _
n As Long, _
Optional vWords As Variant) As String
'===========================================================
' DelWord deletes from sSource, starting with the
' nth word for a length of vWords words.
' If vWords is omitted, all words from the nth word on are
' deleted.
' Usage:
' DelWord("now is not the time", 3) "now is"
' DelWord("now is not the time", 3, 1) "now is the time"
'===========================================================
Const SP As String = " "
Dim lWords As Long 'length of sTarget
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of InStr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word counter
Dim lStart As Long 'position of word n
Dim lEnd As Long 'position of space after last word
lSource = Len(sSource)
DelWord = sSource
sSource = CSpace(sSource)
If IsMissing(vWords) Then
lWords = -1
ElseIf IsNumeric(vWords) Then
lWords = CLng(vWords)
Else
Exit Function
End If
If n = 0 Or lWords = 0 Then Exit Function 'nothing to delete
'find position of n
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = n Then 'the target word-number
lStart = pointer
If lWords < 0 Then Exit Do
End If
If lWords > 0 Then 'lWords was provided
If x = n + lWords - 1 Then 'find pos of last word
lEnd = InStr(pointer, sSource, SP) 'pos of space at end of word
Exit Do 'word found, done
End If
End If
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1 'start of next word
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
DelWord = Trim$(Left$(sSource, lStart - 1))
Else
DelWord = Trim$(Left$(sSource, lStart - 1) & Mid$(sSource, lEnd + 1))
End If
End Function
Public Function MidWord(ByVal sSource As String, _
n As Long, _
Optional vWords As Variant) As String
'===========================================================
' MidWord returns a substring sSource, starting with the
' nth word for a length of vWords words.
' If vWords is omitted, all words from the nth word on are
' returned.
' Usage:
' MidWord("now is not the time", 3) "not the time"
' MidWord("now is not the time", 3, 2) "not the"
'===========================================================
Const SP As String = " "
Dim lWords As Long 'vWords converted to long
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of InStr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word counter
Dim lStart As Long 'position of word n
Dim lEnd As Long 'position of space after last word
lSource = Len(sSource)
sSource = CSpace(sSource)
If IsMissing(vWords) Then
lWords = -1
ElseIf IsNumeric(vWords) Then
lWords = CLng(vWords)
Else
Exit Function
End If
If n = 0 Or lWords = 0 Then Exit Function 'nothing to delete
'find position of n
x = 1
pointer = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = n Then 'the target word-number
lStart = pointer
If lWords < 0 Then Exit Do 'include rest of sSource
End If
If lWords > 0 Then 'lWords was provided
If x = n + lWords - 1 Then 'find pos of last word
lEnd = InStr(pointer, sSource, SP) 'pos of space at end of word
Exit Do 'word found, done
End If
End If
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1 'start of next word
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
MidWord = Trim$(Mid$(sSource, lStart))
Else
MidWord = Trim$(Mid$(sSource, lStart, lEnd - lStart))
End If
End Function
Public Function CSpace(sSource As String) As String
'==================================================
'CSpace converts blank characters
'(ascii: 9,10,13,160) to space (32)
'
' cSpace("a" & vbTab & "b") "a b"
' cSpace("a" & vbCrlf & "b") "a b"
'==================================================
Dim pointer As Long
Dim pos As Long
Dim x As Long
Dim iSpace(3) As Integer
' define blank characters
iSpace(0) = 9 'Horizontal Tab
iSpace(1) = 10 'Line Feed
iSpace(2) = 13 'Carriage Return
iSpace(3) = 160 'Hard Space
CSpace = sSource
For x = 0 To UBound(iSpace) ' replace all blank characters with space
pointer = 1
Do
pos = InStr(pointer, CSpace, Chr$(iSpace(x)))
If pos = 0 Then Exit Do
Mid$(CSpace, pos, 1) = " "
pointer = pos + 1
Loop
Next x
End Function
Public Function SplitString(iSource As String, iTarget As String, Optional BeforeTarget As Boolean = False) As String
'==================================================
'Returns the characters before or after the split
'identifier. By default will return text after id,
'set BeforeTarget as true to return the text before
'it.
'==================================================
If BeforeTarget = True Then
SplitString = DelWord(iSource, WordPos(iSource, iTarget))
Else
SplitString = DelWord(iSource, 1, WordPos(iSource, iTarget))
End If
End Function