Custom string funkcije

Code:
Sub example_of_parsing()

'* This is an example of how to parse a sentence into individual words.

'* Press F5 to run this code

Dim i As Integer

Dim s As String

Dim sWord As String

i = 1

s = "This is the new house next door." '<< Put the sentence here.

sWord = xg_GetSubString(s, i, " ")

Do While sWord <> ""

MsgBox sWord

i = i + 1

sWord = xg_GetSubString(s, i, " ")

Loop

End Sub

Sub examples()

'* Example of the functions in this module

'*

'* To test the functions, un-comment the line, and click the go/continue button (or press f5)

Dim MyField As String

MyField = "123456789"

'MsgBox xg_GetWordsBetween("The Lazy Fox", "The", "Fox")

'MsgBox xg_GetLastWord("The Lazy Fox") '* Get last word in sentence

'MsgBox xg_GetSubString("The Lazy Fox", 2, " ") '* Get second substring, " " is delimiter

'MsgBox xg_GetSubString("a;b;c;d;e;f;g;h", 4, ";") '* Get 4th substring, ";" is delimiter

'MsgBox xg_ReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"

'MsgBox xg_lPad(MyField, "0", 10) '* Left pad with 0 to length of 10 chars

'MsgBox xg_RPad(MyField, "x", 12) '* Right pad with "x" to length of 12 chars

End Sub

Function xg_lPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String

'* Pads characters on the left of a string out to a desired total string length

'* Returns the padded string

xg_lPad = xg_Repeat(sPadChar, iTotalDesiredLengthOfString - Len(Trim(sStringToPad))) & Trim(sStringToPad)

End Function

Function xg_RPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String

Dim i As Integer

Dim sFill As String

sFill = ""

If Len(sStringToPad) < iTotalDesiredLengthOfString Then

For i = 1 To (iTotalDesiredLengthOfString - Len(sStringToPad))

sFill = sFill & sPadChar

Next i

End If

xg_RPad = sStringToPad & sFill

End Function

Function xg_Repeat(sStringToRepeat As String, iNumOfTimes As Integer) As String

Dim i As Integer

Dim s As String

s = ""

For i = 1 To iNumOfTimes

s = s & sStringToRepeat

Next i

xg_Repeat = s

End Function

Function xg_ReplaceAllWith(sMainString As String, sSubString As String, sReplaceString As String) As String

'* Recursive function to replace all occurences of sSubString

'* with sReplaceString in sMainString

Dim i As Integer

Dim ipos As Integer

Dim s As String

Dim s1 As String, s2 As String

s = sMainString

ipos = InStr(1, sMainString, sSubString)

If ipos = 0 Then

GoTo Exit_xg_ReplaceAllWith

End If

s1 = Mid(sMainString, 1, ipos - 1)

s2 = Mid(sMainString, ipos + Len(sSubString), Len(sMainString))

s = s1 & sReplaceString & xg_ReplaceAllWith(s2, sSubString, sReplaceString)

Exit_xg_ReplaceAllWith:

xg_ReplaceAllWith = s

End Function

Function xg_GetWordsBetween(sMain As String, s1 As String, s2 As String) As String

'* Returns a trimmed substring of the string 'sMain' that lies between substrings s1 and s2

'* Ex.: xg_GetWordsBetween("The Lazy Fox", "The", "Fox") returns "Lazy".

On Error Resume Next

Dim iStart As Integer, iEnd As Integer

iStart = InStr(1, sMain, s1) + Len(s1)

iEnd = InStr(iStart, sMain, s2)

xg_GetWordsBetween = Trim(Mid(sMain, iStart, iEnd - iStart))

End Function

Function xg_GetLastWord(sStr As String) As String

'* Returns the last word in sStr

Dim i As Integer

Dim ilen As Integer

Dim s As String

Dim stemp As String

Dim sLastWord As String

Dim sHold As String

Dim iFoundChar As Integer

stemp = ""

sLastWord = ""

iFoundChar = False

sHold = sStr

ilen = Len(sStr)

For i = ilen To 1 Step -1

s = right(sHold, 1)

If s = " " Then

If Not iFoundChar Then

'* skip spaces at end of string.

Else

sLastWord = stemp

Exit For

End If

Else

iFoundChar = True

stemp = s & stemp

End If

If Len(sHold) > 0 Then

sHold = left(sHold, Len(sHold) - 1)

End If

Next i

If sLastWord = "" And stemp <> "" Then

sLastWord = stemp

End If

'MsgBox "lastword =" & Trim(sLastWord)

xg_GetLastWord = Trim(sLastWord)

End Function

Function xg_GetSubString(mainstr As String, n As Integer, delimiter As String) As String

'* Get the "n"-th substring from "mainstr" where strings are delimited by "delimiter"

Dim i As Integer

Dim substringcount As Integer

Dim pos As Integer

Dim strx As String

Dim val1 As Integer

Dim w As String

On Error GoTo Err_xg_GetSubString

w = ""

substringcount = 0

i = 1

pos = InStr(i, mainstr, delimiter)

Do While pos <> 0

strx = Mid(mainstr, i, pos - i)

substringcount = substringcount + 1

If substringcount = n Then

Exit Do

End If

i = pos + 1

pos = InStr(i, mainstr, delimiter)

Loop

If substringcount = n Then

xg_GetSubString = strx

Else

strx = Mid(mainstr, i, Len(mainstr) + 1 - i)

substringcount = substringcount + 1

If substringcount = n Then

xg_GetSubString = strx

Else

xg_GetSubString = ""

End If

End If

Exit Function

Err_xg_GetSubString:

MsgBox "xg_GetSubString " & err & " " & err.Description

Resume Next

End Function