Hi all,
I've drafted a macro that should help people to reply to emails from a shared mailbox, generating a template.
They need to fill some cells with the client's name, etc, and then click on a button (which is basically a shape with the vba macro assigned to it) to generate the template email.
So the macro generates a reply to the sender's email address, with the same subject and showing the sender's email at the bottom.
The macro works correctly when replying to an email from my inbox, but it doesn't when replying to an email from the shared mailbox.
Can someone please help me with this? I am not an expert at all, I am trying to learn as much as possible from this forum!
Thanks to anyone who can help!
Sub template1()
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1)
Dim OutlookConversation As Object
Set OutlookConversation = OutlookMail.GetConversation
Dim OutlookTable As Object
Set OutlookTable = OutlookConversation.GetTable
Dim OutlookAr As Variant
OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)
Dim OutlookReplyToThisMail As Object
Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))
Dim strbody As String
imagePath = "\\abc-01.company-com\Group_Data\ABC\DEF \Imagines\"
Image1 = "image1.jpg"
Image2 = "image2.gif"
strbody = "<img src='" & Image1 & "'/></b><br>" & _
"<br>Dear " & ActiveSheet.Range("E9") & ",<br>" & _
"<br>I'm pleased to confirm that we have successfully created the blablabla for:<br>" & _
"<br><b>" & ActiveSheet.Range("F120") & "</b>" & _
"If you have any further questions, please do not hesitate to contact us.<br>Kind regards,<br>" & _
"<br>" & ActiveSheet.Range("K9") & "<br>" & _
"<img src='" & Image2 & "'/></b><br>" & _
"<br><p style='font-family:BentonSans Light;font-size:10'>" & ActiveSheet.Range("F98") & "</p>" & _
"<p style='font-family:BentonSans Light;font-size:10'>" & ActiveSheet.Range("F96") & "</p><br>"
On Error Resume Next
With OutlookReplyToThisMail.ReplyAll
.SentOnBehalfOfName = "sharedemail@company.com"
.HTMLBody = strbody & .HTMLBody
.attachments.Add (imagePath & Image1)
.attachments.Add (imagePath & Image2)
.Display End With
On Error GoTo 0 Set OutMail = Nothing
Set OutApp = NothingEnd Sub
I've drafted a macro that should help people to reply to emails from a shared mailbox, generating a template.
They need to fill some cells with the client's name, etc, and then click on a button (which is basically a shape with the vba macro assigned to it) to generate the template email.
So the macro generates a reply to the sender's email address, with the same subject and showing the sender's email at the bottom.
The macro works correctly when replying to an email from my inbox, but it doesn't when replying to an email from the shared mailbox.
Can someone please help me with this? I am not an expert at all, I am trying to learn as much as possible from this forum!
Thanks to anyone who can help!
Sub template1()
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1)
Dim OutlookConversation As Object
Set OutlookConversation = OutlookMail.GetConversation
Dim OutlookTable As Object
Set OutlookTable = OutlookConversation.GetTable
Dim OutlookAr As Variant
OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)
Dim OutlookReplyToThisMail As Object
Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))
Dim strbody As String
imagePath = "\\abc-01.company-com\Group_Data\ABC\DEF \Imagines\"
Image1 = "image1.jpg"
Image2 = "image2.gif"
strbody = "<img src='" & Image1 & "'/></b><br>" & _
"<br>Dear " & ActiveSheet.Range("E9") & ",<br>" & _
"<br>I'm pleased to confirm that we have successfully created the blablabla for:<br>" & _
"<br><b>" & ActiveSheet.Range("F120") & "</b>" & _
"If you have any further questions, please do not hesitate to contact us.<br>Kind regards,<br>" & _
"<br>" & ActiveSheet.Range("K9") & "<br>" & _
"<img src='" & Image2 & "'/></b><br>" & _
"<br><p style='font-family:BentonSans Light;font-size:10'>" & ActiveSheet.Range("F98") & "</p>" & _
"<p style='font-family:BentonSans Light;font-size:10'>" & ActiveSheet.Range("F96") & "</p><br>"
On Error Resume Next
With OutlookReplyToThisMail.ReplyAll
.SentOnBehalfOfName = "sharedemail@company.com"
.HTMLBody = strbody & .HTMLBody
.attachments.Add (imagePath & Image1)
.attachments.Add (imagePath & Image2)
.Display End With
On Error GoTo 0 Set OutMail = Nothing
Set OutApp = NothingEnd Sub
