'---------------------------------------------------------------------------------------
' Procedure : ParseName
' Author : ****
' Created : 2/23/2010
' Purpose : To parse a field containing the person's full name and to return
' the first name, or the initial if it exists, or last name depending on the
' value of strWhich.
'
' NOTE: The format of the fullname field is
' Lastname, Firstname Initial(may not be present)
' eg a)De Jesus, Charlene K.
' b)O'Sullivan, Margaret
'---------------------------------------------------------------------------------------
' Last Modified: 18-Aug-2016 ***
'
' adjusted logic and tested
' the fullname must be followed by a comma
' a space after the lastname/before first name is optional
'
' ******
' Inputs: strname == the person's fullname
' strWhich = F First Name
' = M Middle Initial
' = L Last Name
' Dependency: N/A
'------------------------------------------------------------------------------
'
Function ParseName(strName As String, strWhich As String) As String
Dim strUtil As String
Dim strLastname As String
Dim strFirstname As String
Dim strMiddle As String
Dim PosnOfComma As Integer, PosnOfSpace As Integer
10 On Error GoTo ParseName_Error
20 strUtil = Trim(strName) 'remove any leading/trailing spaces
30 PosnOfComma = InStr(1, strUtil, ",")
40 PosnOfSpace = InStr(PosnOfComma + 1, strUtil, " ") 'looking for a space
'Debug.Print PosnOfSpace - PosnOfComma
50 strLastname = Left(strUtil, InStr(1, strUtil, ",") - 1)
'need a check to see if an initial exists
60 strUtil = Mid(strUtil, PosnOfComma + 1)
'strUtil is now devoid of lastname
70 strUtil = Trim(strUtil)
80 If InStr(strUtil, " ") = 0 Then 'there is no initial
90 strMiddle = vbNullString
100 strFirstname = Trim(strUtil)
110 Else
'remove leading/trailing spaces
120 strMiddle = Right(strUtil, Len(strUtil) - InStrRev(strUtil, " "))
130 strFirstname = Mid(strUtil, 1, InStr(strUtil, " ") - 1)
140 End If
150 Select Case strWhich
Case "F"
160 ParseName = strFirstname
170 Case "L"
180 ParseName = strLastname
190 Case "M"
200 ParseName = strMiddle
210 Case Else
220 ParseName = vbNullString
230 End Select
240 On Error GoTo 0
250 Exit Function
ParseName_Error:
260 MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure ParseName of Module Module4"
End Function