Extracting initials from a single string - vba

Question

I am looking to extract initials from a single textbox using Left, mid and other similar functions. The user enters their first, middle initial and last name; assuming spaces and a period after the middle initial. I need to ensure the initials extracted are uppercase, even if the text is entered in lowercase. Any assistance in a code that can accomplish this in VBA for Access would be appreciated. I am able to use the functions individually but am new to coding and am unsure how to string them together correctly.
Private Sub cmdGreeting_Click()
strOutput = Left(txtInput.Value, 1) & Mid(txtinput.value, 1) & Right(txtinput.value, 1)
lblOutput.Caption = strOutput
End Sub
This is as far as I have gotten and I know it's incorrect because I have no idea how to account for the 3 separate names.

Answer 1

Here's a function based on regex. I'm sure someone will chip in to improve it, my VBA regex is rusty. It's based on the regex here where you can see examples of it matching. If you're not familiar with regex at all, they're frightening initially and it's beyond the scope of an answer to explain them.
However, it works by breaking any input into 5 strings:
Initial character of first name
remainder of name
Initial and . if present
Initial letter of last name
remainder of last name
Then, with some simple UCase and LCase, you can compile the require, formatted name. You may want to change the logic - you did imply there would be a middle initial but this assumes it won't always be there, and the dot after the initial may or may not be there.
Note: you need to enable regex in Excel - instructions
Sub normalise()
Debug.Print (proper("Reginald D. Hunter"))
Debug.Print (proper("reginald D. hunter"))
Debug.Print (proper("rEGINALD d. Hunter"))
Debug.Print (proper("Reginald D Hunter"))
Debug.Print (proper("Reginald Hunter"))
Debug.Print (proper("Reginald D. Hunter"))
End Sub
Function proper(text) As String
Dim regexMatch As Object
Dim matches As Object
With New RegExp
.Global = False
.MultiLine = False
.IgnoreCase = False
.Pattern = "([a-zA-Z])([^ ]*)\s*([a-zA-Z]?[. ])?\s*([a-zA-Z])([^ ]*)"
If .test(text) Then
For Each regexMatch In .Execute(text)
Set matches = regexMatch.SubMatches
Next
End If
End With
proper = UCase(matches(0)) + LCase(matches(1))
If Trim(matches(2)) <> "" Then
If InStr(matches(2), ".") Then
proper = proper + " " + Trim(UCase(matches(2))) + " "
Else
proper = proper + " " + Trim(UCase(matches(2))) + ". "
End If
Else
proper = proper + " "
End If
proper = proper + UCase(matches(3)) + LCase(matches(4))
End Function
Results in
Reginald D. Hunter
Reginald D. Hunter
Reginald D. Hunter
Reginald D. Hunter
Reginald Hunter
Reginald D. Hunter
Edit: I misread the question and if you just want initials then replace the last part of the function like so:
proper = UCase(matches(0))
If Trim(matches(2)) <> "" Then
If InStr(matches(2), ".") Then
proper = proper + Replace(Trim(UCase(matches(2))), ".", "")
Else
proper = proper + Trim(UCase(matches(2)))
End If
End If
proper = proper + UCase(matches(3))
gives:
RDH
RDH
RDH
RDH
RH
RDH

Answer 2

This is the code I've been using for a while. It will include the the initials of double-barreled names as well.
?GetInitials("Darren Bartrup-Cook") will return DBC.
?GetInitials("The quick brown fox jumps over the lazy dog") will return TQBFJOTLD.
Public Function GetInitials(FullName As String) As String
Dim RegEx As Object
Dim Ret As Object
Dim RetItem As Object
On Error GoTo ERR_HANDLE
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.IgnoreCase = True
.Global = True
.Pattern = "(\b[a-zA-Z])[a-zA-Z]* ?"
Set Ret = .Execute(FullName)
For Each RetItem In Ret
GetInitials = GetInitials & UCase(RetItem.Submatches(0))
Next RetItem
End With
EXIT_PROC:
On Error GoTo 0
Exit Function
ERR_HANDLE:
'Add your own error handling here.
'DisplayError Err.Number, Err.Description, "mdl_GetInitials.GetInitials()"
Resume EXIT_PROC
End Function