I have working code where I would like to add CC field with preexisting email id's.
Tried all ways around, but not able to crack the code
Sub Reply_Scripting()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\Test.oft")
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Display
End Sub
Simply add
replyEmail.CC = "Om3r#email.com"
Example
Sub Reply_Scripting()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\Test.oft")
replyEmail.CC = "Om3r#email.com"
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.reply.HTMLBody
replyEmail.display
End Sub
It's same as what you did for your body.
Sub Reply_Scripting()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\ashu\Desktop\test.oft")
'/ Add new CC addresses along with existing addresses.
replyEmail.CC = origEmail.CC & ";" & "a#b.com;c#d.com"
replyEmail.BodyFormat = olFormatHTML
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Display
End Sub
Related
I have to make a macro in outlook that enable to respond an email with a template and in this template, attach a contact vcard (as attachment).
Here is the code:
Sub ResponderConAttachment()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim contact As ContactItem
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
Set myNamespace = Application.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
Set origEmail = Application.ActiveInspector.CurrentItem
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\diego\AppData\Roaming\Microsoft\Templates\RespuestaContacto.oft")
Set contact = myContacts.Item(15)
replyEmail.AddBusinessCard (contact) - ***This line gives an error saying is expecting an object.***
replyEmail.To = origEmail.To
replyEmail.CC = origEmail.CC
replyEmail.Subject = origEmail.Subject
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Display
End Sub
Thanks for any help.
Documentation may indicate brackets.
Remove them
replyEmail.AddBusinessCard contact
I want the below code to run when a specific subject appears in an email.
Also to only run if that email has an attachment.
Outlook ignores the attachment part of the rule, and tries to run the code even if the attachment is not there (it seems to only care about the subject).
How do I incorporate a check for attachment in the code?
Public Sub SaveAttachmentsThenOpen(MItem As Outlook.MailItem)
Dim oMail As Variant
Dim oReply As Outlook.MailItem
Dim oItems As Outlook.Items
Dim Msg As Outlook.MailItem
Dim oAttachment As Outlook.Attachment
Dim StrBody As String
Dim oRep As MailItem
Dim sSaveFolder As String
Dim Att As String
Dim Attname As String
Dim sht As Object
Dim Rng As Range
Dim s As String
Dim myAttachments As Outlook.Attachments
Dim XLApp As Object
Dim XlWK As Object
Dim strPaste As Variant
Set oApp = New Outlook.Application
Set oNs = oApp.GetNamespace("MAPI")
Set XLApp = CreateObject("Excel.Application")
With XLApp
.Visible = True
.ScreenUpdating = True
.Workbooks.Open ("C:\Directory\data.xlsx")
.Workbooks.Open ("C:\Directory\WB.xlsb")
End With
Dim strText As String
strText = ".xls"
sSaveFolder = "C:\Directory\TPS_Reports\"
For Each oAttachment In MItem.Attachments
If InStr(1, oAttachment.FileName, strText) > 0 Then
oAttachment.SaveAsFile sSaveFolder & oAttachment.FileName
Attname = oAttachment.FileName
Att = sSaveFolder & oAttachment.FileName
Exit For
End If
Next oAttachment
Set oAttachment = Nothing
XLApp.Workbooks.Open (Att)
XLApp.Visible = True
XLApp.Run ("WB.XLSB!MacroName")
Set sht = XLApp.Workbooks(Attname).ActiveSheet
Set Rng = sht.UsedRange
s = "<table border=1 bordercolor=black cellspacing=0>"
For rw = Rng.Row To Rng.Rows.Count
s = s & "<tr>"
For col = Rng.Column To Rng.Columns.Count
s = s & "<td>" & sht.Cells(rw, col) & "</td>"
Next
s = s & "</tr>"
Next
s = s & "</table>"
Set oRep = MItem.ReplyAll
With oRep
StrBody = "Hello"
.HTMLBody = s
.Send
End With
With XLApp
.DisplayAlerts = False
End With
XLApp.Workbooks(Attname).Save
XLApp.Quit
With XLApp
.DisplayAlerts = True
End With
End Sub
Try waiting for the mail to be in the inbox before checking for the attachment.
Code for the ThisOutlookSession module
Restart Outlook or run Application_Startup manually.
Private WithEvents myItems As Items
Private Sub Application_Startup()
Dim myInbox As folder
Set myInbox = Session.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
End Sub
Private Sub myItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is mailItem Then
If Item.Attachments.Count > 0 Then
SaveAttachmentsThenOpen Item
End If
End If
End Sub
Private Sub test()
myItems_ItemAdd ActiveInspector.currentItem
End Sub
I have this code to a vba outlook macro to reply all.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyall As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyall = mail.replyall
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyall
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.Display
End With
End If
Next
End Sub
I am trying to add a functionality so that when the original email brings an attachment (docx, pdf), when I reply all using this macro it will also use the original attachment and place it as an attachment in the reply all email.
How can I achieve this?
Forward then populate the .To with what would appear in a ReplyAll.
Option Explicit
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To
.Display
End With
End If
Next
End Sub
I have macro to forward an email with the original attachment to everyone which is involved in the original email chain.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
Is it possible to mark this email has "replied" instead of "forwarded" email?
yes you need only to change Set forwardMail = mail.Forward to Set forwardMail = mail.Reply
You should also change name of variable forwardMail to replyMail and change all variables in code. full code below.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyMail = mail.Reply
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
If you mean you want to change the icon to the one that represents "replied", you can change it in the following way...
' Set property PR_ICON_INDEX to 261
objItem.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x10800003", 261
objItem.Save
I'm trying to achieve a macro that will reply to the sender of a selected email with a shared template.
At the moment I have two seperate macros.
Will reply to sender and insert their address.
Will reply with a template (but doesn't insert the senders address).
I was wondering whether it's possible to combine the two to achieve my aim?
So that when you run the macro it will reply to the email with a template and the original sender's address and subject filled in?
My knowledge of VBA is quite limited so I'm not sure if/how it's possible. Here's what I have.
1:
Public Sub AccountSelection()
Dim oAccount As Outlook.Account
Dim strAccount As String
Dim olNS As Outlook.NameSpace
Dim objMsg, oMail As MailItem
Set olNS = Application.GetNamespace("MAPI")
Set objMsg = ActiveExplorer.Selection.Item(1).Reply
If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then
Set oMail = ActiveExplorer.Selection.Item(1)
On Error Resume Next
For Each Recipient In oMail.Recipients
strRecip = Recipient.Address & ";" & strRecip
Next Recipient
If InStr(strRecip, "alias#domain1.com") = 1 Then
strAccount = "alias#domain1.com"
Else
End If
For Each oAccount In Application.Session.Accounts
If oAccount.DisplayName = strAccount Then
objMsg.SendUsingAccount = oAccount
Else
End If
Next
objMsg.Display
Else
End If
Set objMsg = Nothing
Set olNS = Nothing
End Sub
2.
Sub TacReply()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Set origEmail = Application.ActiveExplorer.Selection(1)
Set replyEmail = Application.CreateItemFromTemplate("S:\Share\TWGeneral.oft")
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.SentOnBehalfOfName = "email#domain.com"
replyEmail.Display
End Sub
Any help would be much appreciated! Thanks!
To determine the name(s) to send replies, not necessarily the sender
origEmail.Reply.To
.
Sub TacReply()
Dim origEmail As mailItem
Dim replyEmail As mailItem
Set origEmail = ActiveExplorer.Selection(1)
Set replyEmail = CreateItemFromTemplate("S:\Share\TWGeneral.oft")
replyEmail.To = origEmail.Reply.To
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.SentOnBehalfOfName = "email#domain.com"
replyEmail.Recipients.ResolveAll
replyEmail.Display
Set origEmail = Nothing
Set replyEmail = Nothing
End Sub