Ken,
Thanks for the reply.
I ended up creating a solution that works, however could easily be
cleaned up quite a bit.
To use this code simply create two buttons on a custom toolbar (note:
I removed the default 'Reply' (ALT+R) and 'Reply to All (ALT+L)
toolbar buttons and manually added custom buttons with the same
hotkey) and paste the code in any module in Outlook.
Any comments/updates would be greatly appreciated (as I know very
little about coding in Outlook).
-------------------------
Sub ReplyWithName()
'Hotkey: ALT+R (insert custom toolbar)
Call ReplyWithNameFunction(False)
End Sub
Sub ReplyToAllWithName()
'Hotkey: ALT+L (insert custom toolbar)
Call ReplyWithNameFunction(True)
End Sub
Sub ReplyWithNameFunction(reply_to_all As Boolean)
On Error GoTo errhand
Dim objItem As Object
Dim TempObj As Object
Set objItem = Application.ActiveExplorer.Selection.item(1)
'/ check reply to all
'If reply_to_all = True Then
'QYN = MsgBox("Do you really want to reply to all original
recipients?", vbYesNo, "Reply to All?")
'If QYN = vbNo Then reply_to_all = False
'End If
'/ reply type
If reply_to_all = True Then
Set TempObj = objItem.ReplyAll
Else
Set TempObj = objItem.Reply
End If
Dim sender_name As String
sender_name = objItem.SenderName
sender_first_name = GetFirstName(sender_name, objItem.Body)
With TempObj
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<span style='font-size:10.0pt;font-
family:""Calibri""'>" _
& sender_first_name & vbLf & vbLf _
& "</p><br /> </p><br /> </p><br />Regards,<br />-Brian" _
& .HTMLBody
.Display
End With
'TempObj.Body = TempObj.HTMLBody '(insert HTML text in email)
If sender_first_name <> "" Then
Call RunPauseTimer(0.5)
SendKeys "{Down}"
SendKeys "{Down}"
End If
errhand:
Set objItem = Nothing
Set TempObj = Nothing
End Sub
Public Function GetFirstName(sender_name As String, msg_txt As String)
As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'To Be Updated:
' - what if name contains comma but no space
' - user uses a nickname (analyze signature - comparing last name)?
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo errhand
'/ check for space
space_break = InStr(1, sender_name, " ")
check_comma_space = InStr(1, sender_name, ", ")
'/ check if name contains a space
If space_break > 0 Then
'/ check if name contains a comma and space (last name likely
first)
If check_comma_space = 0 Then
first_name = StrConv(Left(sender_name, space_break - 1),
vbProperCase)
Else
'/ if name after comma
after_comma_txt = Trim(mid(sender_name, check_comma_space + 2,
999))
'/ check for space after comma
check_space_after_comma_txt = InStr(1, after_comma_txt, " ")
If check_space_after_comma_txt = 0 Then
first_name = StrConv(after_comma_txt, vbProperCase)
Else
first_name = StrConv(Left(after_comma_txt,
check_space_after_comma_txt - 1), vbProperCase)
End If
End If
'/ get last name (for nickname check)
'last_name_break = InStrRev(sender_name, " ")
'last_name = StrConv(Trim(mid(sender_name, last_name_break)),
vbProperCase)
Else
'/ name does not contain a space (email address)
check_period = InStr(1, sender_name, ".")
check_at = InStr(1, sender_name, "@")
If (check_period <= 2) Or (check_at = 0) Or (check_period >
check_at) Then
GetFirstName = ""
Exit Function
Else
'/ parse email address
email_name_break = InStr(1, sender_name, "@") - 1
email_name = Left(sender_name, email_name_break)
first_name = StrConv(Left(email_name, check_period - 1),
vbProperCase)
'/ get last name (for nickname check)
'last_name_break = InStrRev(email_name, ".")
'last_name = StrConv(Trim(mid(email_name, last_name_break + 1)),
vbProperCase)
End If
End If
GetFirstName = Trim(first_name) & ","
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Exit Function
errhand:
GetFirstName = ""
End Function
Function RunPauseTimer(pause_seconds As Double)
On Error GoTo err
Dim PauseTime, Start, Finish, TotalTime
PauseTime = pause_seconds ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
err:
End Function