Would you want it to be more automatic or do you want the code only to run
from a button?
"Brian B." <brianblanchett@gmail.com> wrote in message
news:530cbaae-fb74-4246-a497-88fc5ed4ea1e@f6g2000yqa.googlegroups.com...
> 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