I want to convert incoming HTML mail in Outlook to "plain text" and forward the e-mail.
I tried several examples of code.
Sub ConvertToPlain(MyMail As MailItem)
Dim strID As String
Dim objMail As Outlook.MailItem
strID = MyMail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
objMail.BodyFormat = olFormatPlain
objMail.Save
Set objMail = Nothing
End Sub
You can just create a new mail-item, and set the .body property. Reading the .body of a mail-item only gets the text, without any formatting (as opposed to reading the .HTMLBody, which gets the full HTML).
Here's an example of a sub that'll send the unformatted text of an email to whatever addresses you specify
Sub sendPlainText(MyMail As MailItem, sendTo As String)
Dim newMail As Outlook.MailItem
Set newMail = Application.CreateItem(olMailItem) 'Create a new email
With newMail
.To = sendTo 'Whoever you want to send the new mail item to
.subject = MyMail.subject 'Copy subject of original email
.Body = MyMail.Body 'Copy plain text of body to new mail item
.send 'Send the new email
End With
End Sub
Related
I receive support requests in a shared exchange mailbox in Outlook 2013.
I forward the mails, which I am supposed to treat, to an external ticketing system. Before forwarding, I copy the original sender's address into the reply-to address.
The following macro would be perfect if:
the original sender's address would be copied into the reply-to address, and
if it could set the category of the original mail to "myname" and mark it as done.
Sub BatchRedirectEmails()
Dim objSelection As Outlook.Selection
Dim i As Long
Dim objMail As Outlook.MailItem
Dim objRedirectMail As Outlook.MailItem
'Get all selected emails
Set objSelection = Application.ActiveExplorer.Selection
If Not (objSelection Is Nothing) Then
For i = objSelection.Count To 1 Step -1
If TypeOf objSelection(i) Is MailItem Then
Set objMail = objSelection(i)
'Redirect each email
Set objRedirectMail = objMail.Forward
With objRedirectMail
'Add more recipients as per your needs
.Recipients.Add ("john#datanumen.com")
.Recipients.Add ("abby#datanumen.com")
.Recipients.Add ("coral#datanumen.com")
.Recipients.Add ("david#datanumen.com")
.Recipients.ResolveAll
.Subject = objMail.Subject
.HTMLBody = objMail.HTMLBody
.Send
End With
End If
Next
End If
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'm trying to send the active Excel workbook as an attachment via Outlook.
Whenever I run the code it says
Invalid use of New key word
at New Outlook.MailItem`.
Sub SendOutlook()
'Declaring Variables
Dim OutlookApp As Outlook.Application
Dim OutlookEmail As Outlook.MailItem
'Assigning variables to create outlook application and mailitem
Set OutlookApp = New Outlook.Application
Set OutlookEmail = New Outlook.MailItem
With OutlookEmail
'Format of the mail
.BodyFormat = olFormatPlain
'Body of the mail
.Body = "Dear Someone" & vbNewLine & "How are you?"
'To whom you want to send mail
.To = "Someone#somewhere.com"
'Subject of mail
.Subject = "Write Subject Here"
'TO add an attachment
.Attachments.Add ActiveWorkbook.FullName
'sends the mail
.Send
End With
End Sub
You cannot create a MailItem via New. It must be created using CreateItem of the the Outlook Application Object.
Set OutlookApp = New Outlook.Application
Set OutlookEmail = OutlookApp.CreateItem(olMailItem)
As far as I got to know from the research is that Programmatic access to sending emails is a security risk, so it's not allowed via VBA.
You can use a programmatic approach with the following:
Option Explicit
Private outlook_app As Object
Private outlook_mailItem As Variant
Sub send_email()
Set outlook_app = CreateObject("Outlook.Application")
With outlook_app.CreateItem(outlook_mailItem)
.To = "Someone#somewhere.com"
.Subject = "Write Subject Here"
.Body = "Dear Someone" & vbNewLine & "How are you?"
.send
End With
Set outlook_app = Nothing
End Sub
I want email addresses that are stored in the array "emails" put into the "To" part of an email.
I get a type mismatch error.
Sub Email_Click()
Dim myOutlook As Outlook.Application
Dim objMailMessage As Outlook.MailItem
Dim emails As Variant
emails = Array("a#a.com", "b#b.com")
Set myOutlook = Outlook.Application
Set objMailMessage = myOutlook.CreateItem(0)
With objMailMessage
.Display
.To = emails
.Subject = ""
.HTMLBody = ""
.Save
.Close olPromptForSave
End With
End Sub
To close this question out, use Join:
.To = Join(emails, ";")
I search my Sent Mail in Outlook and open the last email to a specified email address (this part is done).
I want to add text to the email chain, while keeping the previous messages intact.
The code below creates a "blank-slate" so that all of the previous email correspondence is lost.
What do I need to do to add text to the Body of the email?
FunctionComposeResponse(searchEmail As String, emailBody As String)
Dim currDateTime As Date: currDateTime = Now()
Dim tenDayPrior As Date: tenDayPrior = DateValue(CStr(Now())) - 10 & " 07:00:00 AM"
Dim olApp As Outlook.Application
Dim olNS As NameSpace
Dim Fldr As Folder
Dim olReply As Outlook.MailItem
Dim msg As Object
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set Fldr = olNS.GetDefaultFolder(olFolderSentMail)
For Each msg In Fldr.Items
If TypeName(msg) = "MailItem" Then
For Each recipient in msg.recipients
If recip.Address = searchEmail Then
If msg.SentOn >= tenDayPrior And msg.SentOn <= currDateTime Then
Set olReply = msg.ReplyAll
With olReply
.BodyFormat = olFormatHTML
.HTMLBody = emailBody
.Save
.Close olSave
End With
End If
End If
Next recip
End If
Next msg
End Function
By setting
.HTMLBody = emailBody
you overwrite everything that was there before.
You need to insert your text into the existing .HTMLBody.
For new mailitems, where I want to preserve the default HTML signature, I use the following - inspect your existing .HTMLBody to find out if this will also work for Reply (if not: adapt).
' emailBody is plain text -> encode as HTML
emailBody = HtmlEncode(emailBody)
' Outlook-HTML: mail text begins with this line:
' <p class=MsoNormal><o:p> </o:p></p>
' Insert my text instead of the first
oItem.HtmlBody = Replace(oItem.HtmlBody, " ", emailBody, Count:=1)