Parsing a string in MSAccess VBA with varying numbers of delimiters - vba

Question

In MSAccess VBA, I'm trying to parse a name field into last, first, middle. The problem is that the incoming format is not consistent:
Jones John Q
Doe Jane
Smith Robert X
This is what I'm doing
Dim rsNames As DAO.Recordset
Set rsNames = CurrentDb.OpenRecordset("SELECT * FROM tblInput")
If Not (rsNames.EOF And rsNames.BOF) Then
rsNames.MoveFirst
Do Until rsNames.EOF = True
strFullName = rsNames!Name
intLength = Len(strFullName)
intSpacePos = InStr(strFullName, " ")
strLname = Left(strFullName, intSpacePos - 1)
strFname = Mid(strFullName, intSpacePos, intLength - (intSpacePos - 1))
strFname = Trim(strFname)
If Len(strFname) + Len(strLname) + (intSpacePos - 1) < intLength Then
strMI = Right(strFullName, 1)
End If
rsNames.Edit
rsNames!LastName = strLname
rsNames!FirstName = strFname
rsNames!MiddleInitial = strMI
rsNames.Update
rsNames.MoveNext
Loop
Results
LastName: Jones
FirstName: John Q
Middle Initial: Q
LastName: Doe
FirstName: Jane
Middle Initial: E
If I change this line
strFname = Mid(strFullName, intSpacePos, intLength - (intSpacePos - 1)) to
strFname = Mid(strFullName, intSpacePos, intLength - (intSpacePos), the lines with middle initials parse correctly, but the lines without middle initials cut off the last character of the first name and move it to the middle initial field (Doe Jan E)
I've tried using split and replace but neither works properly because of the varying numbers of spaces separating the fields. I'm wondering if my only option is to read the string character by character and building the individual fields that way, but before I go down that path, am I missing something obvious? I have no control over the incoming file.

Answer 1

I'll propose you to use split() function, in this manner:
Dim rsNames As DAO.Recordset
Dim strLname As String, strFname As String, strMI As String
Dim i As Integer
Dim x, arr As Variant
Set rsNames = CurrentDb.OpenRecordset("SELECT * FROM tblInput")
If Not (rsNames.EOF And rsNames.BOF) Then
'rsNames.MoveFirst
Do Until rsNames.EOF = True
arr = Split(rsNames!Name)
strLname = ""
strFname = ""
strMI = ""
i = 0
For Each x In arr
If (x <> "") Then
If (i = 0) Then
strLname = x
ElseIf (i = 1) Then
strFname = x
Else
strMI = x
End If
i = i + 1
End If
'
If (i > 2) Then
Exit For
End If
Next
'
rsNames.Edit
rsNames!LastName = strLname
rsNames!FirstName = strFname
rsNames!MiddleInitial = strMI
rsNames.Update
rsNames.MoveNext
Loop
End If
rsNames.Close
Set rsNames = Nothing
We use a loop to find non empty split strings as LastName, FirstName and Middle initial.
This pure VBA code avoids us to use extra VBScript.RegExp replacement.

Answer 2

I would lean towards using RegEx and Split:
Private Sub Test()
Dim strFullName As String
Dim NameParts As Variant
strFullName = "Jones John Q"
With CreateObject("vbscript.regexp")
.Pattern = "\s+"
.Global = True
strFullName = .Replace(strFullName, " ")
End With
NameParts = Split(strFullName, " ")
End Sub
NameParts is an array containing Last, First, and possibly Middle names.

Answer 3

Are First Name and Last Name always in the same position? If so, the use of split can be use to determine the existence of the middle, i may be missing something though, i'd go for
Dim a() As String
a() = Split(s, Chr(32))
strLastName = a(0)
strFirstName = a(1)
If UBound(a) = 2 Then
strMiddle = a(2)
Else
strMiddle = ""
End If
Debug.Print strFirstName, strMiddle, strLastName
or something a bit less elegant
If Len(s) - Len(Replace(s, Chr(32), "")) = 2 Then
strMiddle = Right(s, Len(s) - InStrRev(s, Chr(32)))
End If