VBA Code Help Needed

[T. Wilson]

Hello,

I am trying to replicate a feature found in MS Outlook 2003 in the Contact
section. When a user is entering new contact information, they are
presented with a command button labeled "Full Name..." and a text box. If
the user enters, for instance, Todd Wilson, and the command button is
pressed, the name is parsed so that "Todd" appears in the First Name field,
and "Wilson" appears in the Last Name field. Ok, I can figure out how to do
that, no problem, but Outlook can also handle entries like Mr. Todd A.
Wilson, and Todd A. Wilson, and Todd A. Wilson III properly placing the
Title, Middle Initial, and Suffix.

Does anyone have a code snippet that they would be willing to share to
replicate this feature? I might be able to code this on my own, but I'm
sure that it would be ugly.

Thanks,

Todd

 

[Andrew Smith]

I've done this using a class module - you'll need to modify it a bit if you
need the suffix, but you can use the same approach as I've used to work out
the title.

Enter the following code into a new class module, and call it NameSplitter:
'Start of code:
Option Compare Database
Option Explicit

Private mstrFirstName As String
Private mstrLastName As String
Private mstrTitle As String
Private mstrFullName As String
Private mstrMiddleNames As String


Public Property Get FirstName() As String
FirstName = mstrFirstName
End Property

Public Property Get LastName() As String
LastName = mstrLastName
End Property

Public Property Get MiddleNames() As String
MiddleNames = mstrMiddleNames
End Property

Public Property Get Title() As String
Title = mstrTitle
End Property

Public Property Get EnteredName() As String
EnteredName = mstrFullName
End Property

Public Property Let EnteredName(strName As String)

Dim strWords() As String
Dim i As Integer
Dim blnTitle As Boolean
Dim intNames As Integer

mstrFullName = strName

strWords() = Split(mstrFullName, " ")
blnTitle = IsTitle(strWords(0))

If blnTitle Then
mstrTitle = strWords(0)
Else
mstrTitle = ""
End If

intNames = UBound(strWords()) + 1 + blnTitle

Select Case intNames
Case 0 'No names supplied
mstrFirstName = ""
mstrLastName = ""
mstrMiddleNames = ""
Case 1 'Assume only the first name supplied
mstrFirstName = strWords(-blnTitle)
mstrLastName = ""
mstrMiddleNames = ""
Case 2 'Assume first and last names supplied
mstrFirstName = strWords(-blnTitle)
mstrLastName = strWords(UBound(strWords()))
mstrMiddleNames = ""
Case Else 'More than two names - assume first name first and last
name last!
mstrFirstName = strWords(-blnTitle)
mstrLastName = strWords(UBound(strWords()))
For i = 1 - blnTitle To UBound(strWords()) - 1
mstrMiddleNames = mstrMiddleNames & " " & strWords(i)
Next
End Select


End Property

Private Function IsTitle(strWord) As String
IsTitle = strWord = "Mr" Or _
strWord = "mrs" Or _
strWord = "mr." Or _
strWord = "mrs" Or _
strWord = "dr" Or _
strWord = "dr." Or _
strWord = "rev" Or _
strWord = "rev." Or _
strWord = "sir" Or _
strWord = "master"
End Function
'End of class module code.

The following is an example of a function that uses the above class:
'start of example function:
Public Function ParseName(strName As String) As Boolean
Dim objName As NameSplitter

Set objName = New NameSplitter

With objName
.EnteredName = strName
Debug.Print "First name: ", .FirstName
Debug.Print "Last name: ", .LastName
Debug.Print "Middle names:", .MiddleNames
Debug.Print "Title: ", .Title
End With

ParseName = True

End Function

 

[T. Wilson]

THANK YOU! I can work my way through this for my app! This is just what I
needed!

Sincerely,

Todd