Is it possible to write this VBA code any better? - ms-access

Question

Am I reinventing the wheel here? Is there a better way to do this? This VBA function looks for the first instance of a string in the comment field of a form in Access containing 20 characters or less, no spaces, surrounded by (~) tildes, then returns it.
Public Function ParseComment(strComment As String) As String
' This function parses the comment field of the job entry dialog for (~) tilde
' surrounded text, then returns that text.
Dim intCounter As Integer
Dim intFirstChar As Integer
Dim intLastChar As Integer
Dim strResult As String
intFirstChar = 0
intLastChar = 0
intCounter = 0
Do While (intLastChar = 0) And (intCounter < Len(strComment))
intCounter = intCounter + 1
strCharacter = Mid(strComment, intCounter, 1)
If (strCharacter = "~") Then
If intFirstChar Then
intLastChar = intCounter
Else
intFirstChar = intCounter + 1
End If
End If
Loop
strResult = Mid(strComment, intFirstChar, intLastChar - intFirstChar)
If (intLastChar - intFirstChar <= 20) And (intFirstChar <> 0 Or intLastChar <> 0) And Not InStr(strResult, " ") Then
ParseComment = strResult
End If
End Function
Thanks much.

Answer 1

I would use InStr to find the first and second occurences of the ~ character, something like this, rather than looping manually:
Public Function ParseComment(strComment As String) As String
' This function parses the comment field of the job entry dialog for (~) tilde
' surrounded text, then returns that text.
Dim firstTilde As Integer
Dim secondTilde As Integer
Dim strResult As String
firstTilde = 0
secondTilde = 0
strResult = ""
firstTilde = InStr(strComment, "~")
If firstTilde > 0 Then
secondTilde = InStr(firstTilde + 1, strComment, "~")
If (secondTilde > 0) And (secondTilde < 20) Then
strResult = Mid(strComment, firstTilde, secondTilde)
If InStr(strResult, " ") = 0 Then
ParseComment = strResult
End If
End If
End If
End Function
[Disclaimer, I haven't tested this!]

Answer 2

Using the built-in functions might be a little quicker, but don't imagine it will make a critical difference...
Something like:
Public Function getTildeDelimStringPart(inputstring As String) As String
Dim commentStart As Long, commentEnd As Long
commentStart = InStr(1, inputstring, "~")
If commentStart = 0 Then ' no tilde
getTildeDelimStringPart = vbNullString
Exit Function
End If
commentEnd = InStr(1 + commentStart, inputstring, "~")
If commentEnd = 0 Then
getTildeDelimStringPart = vbNullString
Exit Function
End If
getTildeDelimStringPart = Mid(inputstring, commentStart, commentEnd - commentStart + 1)
End Function

Answer 3

I see everyone has given you some more ways to do this (instr is a great way, see Vicky's answer!), so I'll just list up some tips on optimizing your code:
Use Long instead of Integer. VBA will convert them to Long every time.
Default value for Int and Long is 0 in VBA, so no need to declare them so.
Use Mid$ instead of Mid
Using Instr() would be a very effecient way to find location of ~
Fun Tip: If you do want to evaluate each character, fastest way is numeric comparision:
if Asc(Mid$(strComment, intCounter, 1)) = 126 Then

Answer 4

This worked for me:
Public Function ParseComment(strComment As String) As String
Dim regex As Object ' VBScript_RegExp_55.RegExp
Dim regexmatch As Object ' VBScript_RegExp_55.MatchCollection
Set regex = CreateObject("VBScript_RegExp_55.RegExp")
With regex
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "(~[^ ~]{1,20}~)"
End With
Set regexmatch = regex.Execute(strComment)
If regexmatch.Count > 0 Then
ParseComment = regexmatch(0)
End If
End Function
You can add additional parsing at the end if you want to remove the tilde characters.
I tested it on the following string:
ABC~123aA%dwdD~CBA
the function returns ~123aA%dwdD~
Forgot to mention that this code requires VBScript Regular Expressions 5.5 which is located in %windir%\system32\vbscript.dll\3, although the code is late bound so you should just be able to drop it into your project.