Insert First Name in Reply

[Brian B.]

Is there a way to automatically insert the first name of the sender
when I "Reply" or "RepyToAll" to a mail message?

Perference would be for it to automatically appear when I click the
default 'Reply' or 'Reply To All' buttons (potentially via an
ItemReply event?) but if necessary I could easily create a new button
assigned to the macro.

I have reviewed many posts (on this forum and others) but haven't seen
a single full solution, with all necessary code (I am a relative
newbie to Outlook VBA).

Any help would be greatly appreciated.

-Brian

 

[Ken Slovak]

It could be done, but only if the sender was in your contacts. You'd have to
handle Reply() and ReplyAll() events for any selected emails as well as any
open ones. Then you could pick up the recipient of the reply, assuming there
is only one, then you could get the address and try to match it to a
contact and if it matched you could get the contact first name.

If you are using Outlook 2007 or later you could use
Recipient.AddressEntry.GetContact(), which would save a lot of coding. If an
earlier version you'd need to find the contact yourself.

 

[Brian B.]

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

 

[Ken Slovak]

Would you want it to be more automatic or do you want the code only to run
from a button?