Try these string functions
' String Functions
'
' strGetWordsBetween("The Lazy Fox", "The", "Fox")
' strGetLastWord("The Lazy Fox") ' Get last word in sentence
' strGetSubString("The Lazy Fox", 2, " ") ' Get second substring, " " is delimiter
' strGetSubString("a;b;c;d;e;f;g;h", 4, ";") ' Get 4th substring, ";" is delimiter
' strReplaceAllWith("The Lazy Fox is crazed", "az", "onel") ' Replace "az" with "onel"
' strlPad(MyField, "0", 10) ' Left pad with 0 to length of 10 chars
' strRPad(MyField, "x", 12) ' Right pad with "x" to length of 12 chars
Option Compare Database
Option Explicit
' This is an example of how to parse a sentence into individual words.
' Press F5 to run this code
Sub example_of_parsing()
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 = strGetSubString(s, i, " ")
Do While sWord <> ""
MsgBox sWord
i = i + 1
sWord = strGetSubString(s, i, " ")
Loop
End Sub
' Example of the functions in this module
'
' To test the functions, un-comment the line, and click the go/continue button (or press f5)
Sub examples()
Dim MyField As String
MyField = "123456789"
'MsgBox strGetWordsBetween("The Lazy Fox", "The", "Fox")
'MsgBox strGetLastWord("The Lazy Fox") '* Get last word in sentence
'MsgBox strGetSubString("The Lazy Fox", 2, " ") '* Get second substring, " " is delimiter
'MsgBox strGetSubString("a;b;c;d;e;f;g;h", 4, ";") '* Get 4th substring, ";" is delimiter
'MsgBox strReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"
'MsgBox strlPad(MyField, "0", 10) '* Left pad with 0 to length of 10 chars
'MsgBox strRPad(MyField, "x", 12) '* Right pad with "x" to length of 12 chars
End Sub
' Pads characters on the left of a string out to a desired total string length
' Returns the padded string
'
' Example:
'
' strlPad(MyField, "0", 10) '* Left pad with 0 to length of 10 chars
'
Function strlPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
strlPad = strRepeat(sPadChar, iTotalDesiredLengthOfString - Len(Trim(sStringToPad))) & Trim(sStringToPad)
End Function
' Pads characters on the right of a string out to a desired total string length
' Returns the padded string
'
' Example:
'
' strRPad(MyField, "x", 12) '* Right pad with "x" to length of 12 chars
'
Function strRPad(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
strRPad = sStringToPad & sFill
End Function
Function strRepeat(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
strRepeat = s
End Function
' Recursive function to replace all occurences of sSubString
' with sReplaceString in sMainString
'
' Example:
'
' strReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"
'
Function strReplaceAllWith(sMainString As String, _
sSubString As String, sReplaceString As String) As String
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_strReplaceAllWith
End If
s1 = Mid(sMainString, 1, iPos - 1)
s2 = Mid(sMainString, iPos + Len(sSubString), Len(sMainString))
s = s1 & sReplaceString & _
strReplaceAllWith(s2, sSubString, sReplaceString)
Exit_strReplaceAllWith:
strReplaceAllWith = s
End Function
' Returns a trimmed substring of the string 'sMain' that lies between substrings s1 and s2
'
' Example:
'
' strGetWordsBetween("The Lazy Fox", "The", "Fox") returns "Lazy".
'
Function strGetWordsBetween(sMain As String, s1 As String, s2 As String) As String
On Error Resume Next
Dim iStart As Integer, iEnd As Integer
iStart = InStr(1, sMain, s1) + Len(s1)
iEnd = InStr(iStart, sMain, s2)
strGetWordsBetween = Trim(Mid(sMain, iStart, iEnd - iStart))
End Function
' Returns the last word in sStr
'
' Example:
'
' MsgBox strGetLastWord("The Lazy Fox") '* Get last word in sentence
'
Function strGetLastWord(sStr As String) As String
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)
strGetLastWord = Trim(sLastWord)
End Function
' Get the "n"-th substring from "mainstr" where strings are delimited by "delimiter"
'
' Example:
'
' strGetSubString("The Lazy Fox", 2, " ") Get second substring, " " is delimiter
' strGetSubString("a;b;c;d;e;f;g;h", 4, ";") Get 4th substring, ";" is delimiter
'
Function strGetSubString(mainstr As String, n As Integer, delimiter As String) As String
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_strGetSubString
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
strGetSubString = strx
Else
strx = Mid(mainstr, i, Len(mainstr) + 1 - i)
substringcount = substringcount + 1
If substringcount = n Then
strGetSubString = strx
Else
strGetSubString = ""
End If
End If
Exit Function
Err_strGetSubString:
MsgBox GetMsgBoxText(1, "Der skete følgende fejl: ") & vbCrLf & err.Description, vbInformation
Resume Next
End Function
Jeg bruger denne:
Dim MaxUd, FMax, K, i, intSpace As Integer
Dim strnavn As String
DoCmd.OpenForm "form1"
Me.Requery
MaxUd = DMax("[Tæller]", "Tabel1")
For K = 1 To MaxUd
strnavn = LTrim$(Me.[Navn])
FMax = Len(strnavn)
For i = 1 To FMax + 1
If Mid$(strnavn, i, 1) = " " Then Exit For
intSpace = i
Next i
Me.[Fornavn] = LTrim$(Mid$(strnavn, 1, intSpace))
Me.[Efternavn] = LTrim$(Mid$(strnavn, intSpace + 2, FMax))
DoCmd.GoToRecord acForm, "form1", acNext, 1
Next K
DoCmd.GoToRecord acForm, "form1", acPrevious, 1