使用不同数量的分隔符解析 MSAccess 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