I have a client who requires the following functionality in Outlook 2010-:
(1) If an email is RECEIVED and the USER clicks the reply button
(2) Determine the recipient(s) of the email received
(3) If the recipient(s) of the email received are legal'at'example.com, or enquiries'at'example.com, or support'at'example.com then set the FROM field to legal'at'example.com, or enquiries'at'example.com, or support'at'example.com
(4) Insert the signature based on the recipient(s) of the email received
--------------
I have solved how to do steps 1, 3 and 4, but I am at a loss on how to do step 2. If I read the collection of recipients for the current mail object it returns who the replied email is going to (remember the current mail item is the message reply). What I actually require is the recipients for the email received. Can anyone advise me how to do this? Here is my current code-:
--------------
Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
'*************************************************************
Private Sub Application_Startup()
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub
'*************************************************************
Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.Item(1)
End Sub
'*************************************************************
' Reply
Private Sub oItem_Reply(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Dim oResponse As MailItem
Set oResponse = oItem.Reply
'Code below returns recipient of message to be sent. This is not what is required.
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS As String = "LINK_REMOVED"
Set recips = oResponse.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
MsgBox (recip.Name & " SMTP=" & pa.GetProperty(PR_SMTP_ADDRESS))
Next
Dim SigString As String
Dim Signature As String
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
' set the fields here
oResponse.SentOnBehalfOfName = legal'at'example
oResponse.HTMLBody = Signature & oResponse.HTMLBody
oResponse.Display
On Error GoTo 0
bDiscardEvents = False
Set oItem = Nothing
End Sub
'*************************************************************
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
(1) If an email is RECEIVED and the USER clicks the reply button
(2) Determine the recipient(s) of the email received
(3) If the recipient(s) of the email received are legal'at'example.com, or enquiries'at'example.com, or support'at'example.com then set the FROM field to legal'at'example.com, or enquiries'at'example.com, or support'at'example.com
(4) Insert the signature based on the recipient(s) of the email received
--------------
I have solved how to do steps 1, 3 and 4, but I am at a loss on how to do step 2. If I read the collection of recipients for the current mail object it returns who the replied email is going to (remember the current mail item is the message reply). What I actually require is the recipients for the email received. Can anyone advise me how to do this? Here is my current code-:
--------------
Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
'*************************************************************
Private Sub Application_Startup()
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub
'*************************************************************
Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.Item(1)
End Sub
'*************************************************************
' Reply
Private Sub oItem_Reply(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Dim oResponse As MailItem
Set oResponse = oItem.Reply
'Code below returns recipient of message to be sent. This is not what is required.
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Const PR_SMTP_ADDRESS As String = "LINK_REMOVED"
Set recips = oResponse.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
MsgBox (recip.Name & " SMTP=" & pa.GetProperty(PR_SMTP_ADDRESS))
Next
Dim SigString As String
Dim Signature As String
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
' set the fields here
oResponse.SentOnBehalfOfName = legal'at'example
oResponse.HTMLBody = Signature & oResponse.HTMLBody
oResponse.Display
On Error GoTo 0
bDiscardEvents = False
Set oItem = Nothing
End Sub
'*************************************************************
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Last edited: