Code Reply

Increased Geek Quotient
Originally uploaded by bpende

Sometimes you need to reply quickly to inbound email. Here is a VBA personalization Routine Email Reply

*** Code ***
Sub WillInvestigateReply()
Set myItem = GetCurrentItem()
Set myReply = myItem.Reply
Dim MessageText(0 To 3) As String

MessageText(0) = "Please be advised that I have received your email and will give it my attention. I will contact you if I have further questions or when the matter is complete." + vbCrLf + vbCrLf + "Thanks," + vbCrLf + "Yourname" + vbCrLf + "-----Original Message-----" + vbCrLf + "From: " + myItem.SenderName + vbCrLf + "To: " + myItem.ReceivedByName + vbCrLf + "Subject: " + myItem.Subject + vbCrLf + vbCrLf + myItem.Body
MessageText(1) = "Please note that I have received your email and will look into the matter as soon as possible. I will email you if I need additional information." + vbCrLf + vbCrLf + "Thanks," + vbCrLf + "Yourname" + vbCrLf + "-----Original Message-----" + vbCrLf + "From: " + myItem.SenderName + vbCrLf + "To: " + myItem.ReceivedByName + vbCrLf + "Subject: " + myItem.Subject + vbCrLf + vbCrLf + myItem.Body
MessageText(2) = "Please note that your email has been received. I will follow up with you if I have further questions or when the matter is complete." + vbCrLf + vbCrLf + "Thanks," + vbCrLf + "Yourname" + vbCrLf + "-----Original Message-----" + vbCrLf + "From: " + myItem.SenderName + vbCrLf + "To: " + myItem.ReceivedByName + vbCrLf + "Subject: " + myItem.Subject + vbCrLf + vbCrLf + myItem.Body
MessageText(3) = "I will look into the matter as time allows. If I have further questions I will contact you via email." + vbCrLf + vbCrLf + "Thanks," + vbCrLf + "Yourname" + vbCrLf + "-----Original Message-----" + vbCrLf + "From: " + myItem.SenderName + vbCrLf + "To: " + myItem.ReceivedByName + vbCrLf + "Subject: " + myItem.Subject + vbCrLf + vbCrLf + myItem.Body

Dim ReplyText As String
ReplyText = MessageText(RandomNumber(3))
myReply.Body = ReplyText
myReply.Display
End Sub

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
End Function

Public Function RandomNumber(ByVal MaxValue As Long, Optional _
ByVal MinValue As Long = 0)

On Error Resume Next
Randomize Timer
RandomNumber = Int((MaxValue - MinValue + 1) * Rnd) + MinValue

End Function