Public Function DefaultEmailClient(Optional JustName As Boolean = True) As String
' This function returns the default email client.  It returns just the name of the
' program if JustName = True or is missing.  Otherwise, it returns the full path.
'
' DefaultEmailClient() Version 1.0.0
' Copyright © 2023 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
On Error GoTo Err_Handler

    Dim strRegVal As String
    Dim strMailProg As String
    Dim intCharPos As Integer
    Dim intRegValLength As Integer
    Dim objWSShell As Object
    Dim intLastSlashPos As Integer
    
    ' Get the complete value from the registry; something like this:
    ' "C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.EXE"
    Set objWSShell = CreateObject("Wscript.shell")
    strRegVal = objWSShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")
    
    ' Peel off the double quotes around the path and the section after the path.
    
    intRegValLength = Len(strRegVal)
    For intCharPos = intRegValLength To 0 Step -1
        ' In case there's no path.
        On Error Resume Next
        If Mid(strRegVal, intCharPos, 1) = "" Then
            strMailProg = Mid(strRegVal, intCharPos + 1)
            Exit For
        End If
    Next intCharPos

    intRegValLength = Len(strMailProg)
    For intCharPos = 1 To intRegValLength Step 1
        If Mid(strMailProg, intCharPos, 1) = "." Then
            strMailProg = Mid(strMailProg, 1, intCharPos + 3)
            Exit For
        End If
    Next intCharPos

    ' Trim off the leading ".
    If Left(strMailProg, 1) = """" Then
        strMailProg = Right(strMailProg, Len(strMailProg) - 1)
    End If
    
    ' If just the name is needed, extract the name from the full path.
    If JustName Then
        intLastSlashPos = InStrRev(strMailProg, "\")
        If intLastSlashPos > 0 Then
            strMailProg = Right(strMailProg, Len(strMailProg) - intLastSlashPos)
        End If
    End If
    
    DefaultEmailClient = strMailProg

Exit_Proc:
    On Error Resume Next
    Set objWSShell = Nothing
    Exit Function

Err_Handler:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "DefaultEmailClient"
    DefaultEmailClient = ""
    Resume Exit_Proc
End Function