Sending email with picture in html body - vba

I am trying to send an email, with a chart, using VBA in Excel.
When I use .Display the email is created with that picture (chart) inside the email and it is sending.
When I sending straight away using .Send, the picture of the chart disappears from the email.
Also, I would like to better understand parameters after using:
.Attachments.Add PicFilename, 1, 1
What are the numbers "1, 1" which I took from one of the examples on website.

The Attachments.Add method is described in MSDN.
Sub AddAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\Test.doc", _
olByValue, 1, "Test"
myItem.Display
End Sub
Try to save the item before sending it out. Also you can use two calls sequentially if it helps:
mailItem.Display(False)
mailItem.Send()

Related

Send an email with a blank subject

I am a professor interacting with students who do not respond to emails, but who do respond to text messages. So, I am writing an Outlook userform to generate text messages that are sent by Outlook to students' cell phones, e.g., by using email addresses that target the student's cell phone text message service like this: 5405551212#mms.att.net
The problem I am running into is that I don't want to have a Subject for these text messages because that Subject is added as the first line of each text sent to the student and is confusing and looks weird, but, the VBA code olMail.Send will throw this error when the Subject is blank: "Run-time error '-2147467259 (80004005)': Outlook does not recognize one or more names." The names for olMail.To and olMail.CC are fine and the error goes away when I add a non-blank Subject.
Is there a way to programmatically force Outlook to send the email with a blank subject? I have not been able to find a solution searching online other than to make the subject " " (a space)--but that is not an ideal solution because it still adds a "blank" line at the top of each text message because of the space.
I could probably use olMail.Display and then use SendKeys to send the email and answer "Yes" when I am asked if I want to send the email without a subject, but that is clunky.
How can I skip the error and send the email without a subject using VBA?
EDIT:
Here's the code that I was using to add recipients to the mailitem:
Dim olApp As Outlook.Application
Dim olMail As MailItem
olMail.To = Me.tbxEmailAddress 'this would be something like 5405551212#mms.att.net
olMail.CC = "someemail#notmail.com" 'this would be my own email address
olMail.Subject = "" 'blank subject
olMail.Body = Replace(Me.tbxTexts, vbCrLf, "") 'remove extra hard returns
olMail.Send 'this would throw the error mentioned above,
'but if I changed olMail.Subject = "" to
'olMail.Subject = "This is the subject" then no error would occur
Using #Eugene Astafiev's information below, I cobbled together a working solution like this:
Dim myRecipients As Outlook.Recipients
Dim myRecipient As Outlook.Recipient
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = Outlook.Application
olMail.Subject = "" 'blank subject
olMail.Body = Replace(Me.tbxTexts, vbCrLf, "") 'remove extra hard returns
Set myRecipient = olMail.Recipients.Add(tbxEmailAddress)
myRecipient.Type = olTo 'Type is: olBCC, olCC, olOriginator, or olTo
Set myRecipient = olMail.Recipients.Add("someemail#notmail.com")
myRecipient.Type = olBCC
Set myRecipients = olMail.Recipients
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox "Could not resolve: " & myRecipient.Name
End If
Next
End If
olMail.Send 'no error now!
Interestingly, no email address using the myRecipients collection ever reported being unable to be resolved. However, when I tried to resolve the individual myRecipient object/item using myRecipient.Resolve then the text message email address (e.g., 5405551212#mms.att.net) would fail to resolve but my own email address would resolve fine.
Maybe this has something to do with 5405551212#mms.att.net not being an address in my Address Book or Contacts?
At any rate, it does send now. (Note: prior to using the myRecipients.ResolveAll, I did succeed in getting the code I originally had to work by using olMail.Display and then olMail.Send and then using SendKeys "%s" twice--the first time to "click" the Send button and the second time to "click" the "Send Anyway" button when Outlook complained there was no subject. But, clearly the VBA code approach is far superior.)
Thanks to everyone for you help!
Outlook doesn't require setting up the Subject line before submitting items. Use the Recipients.ResolveAll method which attempts to resolve all the Recipient objects in the Recipients collection against the Address Book.
Sub CheckRecipients()
Dim MyItem As Outlook.MailItem
Dim myRecipients As Outlook.Recipients
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipients = myItem.Recipients
myRecipients.Add("Eugene Astafiev")
myRecipients.Add("Nate Sun")
myRecipients.Add("Dan Wilson")
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox myRecipient.Name
End If
Next
End If
End Sub
You may find the following articles helpful:
How To: Fill TO,CC and BCC fields in Outlook programmatically
How To: Create and send an Outlook message programmatically

Outlook Email created in VBA using a template converts to plain text when saved

Below is the code that I am running in ThisOutlookSession. The code is meant to check all incoming emails and if the email is from a certain email address and contains a specific string in the subject then a new email is created from a template and the triggering email is attached and the email is then sent out to a different email address. This portion all works fine.
Also to note I am using windows 10 and office 2016.
The problem that I am having is the email is converted to plain text unless it is displayed first. The template that I have created is saved as a HTML formatted message. I have tried adding lines such as
NewMsg.BodyFormat = olFormatHTML
NewMsg.save
But this doesn't seem to work as the email that is sent was still in the plain text format. If I add the following to that the message it basically works.
NewMsg.BodyFormat = olFormatRichText
NewMsg.save
NewMsg.BodyFormat = olFormatHTML
NewMsg.save
However the above block of code removes a lot of the formatting that was saved in my template such as different fonts/ font sizes.
Am I missing something about working with templates in VBA?
Also The problem that I am having with displaying the message first is two things. The obvious one is the flash that this causes because the message is briefly displayed. The second is my default signature is also added to the displayed message but I wanted to use a custom signature that I built into my template.
Here is my full code with sensitive information removed.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim NewMsg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
If Msg.SenderEmailAddress <> "example#example.com" Then GoTo Skip
If InStr(1, Msg.Subject, "Specific String") > 0 Then 'checks if subject contains the proper string
Set NewMsg = Application.CreateItemFromTemplate("Template Path")
Msg.Subject = Replace(Msg.Subject, "Old Subject", "New subject")
Msg.Save
NewMsg.HTMLBody = NewMsg.HTMLBody
NewMsg.Attachments.Add Msg
NewMsg.Recipients.Add("Example#Example.com")
NewMsg.Subject = Msg.Subject
NewMsg.Save
NewMsg.Send
End If
End If
Skip:
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
End Sub
Reset the HTMLBody property - that will force HTML format:
Msg.HTMLBody = Msg.HTMLBody

Reply Inline With a Outlook Template

I would like to reply to a message inline with a outlook template using a macro.
I am currently using the below code to perform the reply with a template but this opens a pop out reply window.
Sub Reply_Scripting()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Test.oft")
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.reply.HTMLBody
replyEmail.Display
End Sub
I have searched and found there has been similar question answered here. However, I was not able to modify the code to make it work successfully in my case.
Thanks.
I have noticed the following line of code:
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.reply.HTMLBody
Note, you need to get a well formed HTML markup and assign it to the HTMLBody property. But it looks like you try to merge two HTML pages into a single one by adding one to another.
Instead, you need to paste the body content of the template you are loading in the code at the beginning of the body section of the existing item. I.e. right after the <body> tag.
This is what I have for an "auto reply". This DOES NOT allow editing before sending, but easily modified to do so. See comments in code.
Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply
For Each olItem In Application.ActiveExplorer.Selection
olItem.UnRead = False '<<----This marks the email as Read
Set olReply = olItem.ReplyAll '<<----This replies to all recipients
olReply.HTMLBody = "Insert a message or template here" & olReply.HTMLBody
olReply.Display '<<-----Use this to display the email before sending
olReply.Send '<<-----Comment this out if you want to edit before sending
Next olItem
End Sub

Edit, send and save email to file system

We currently have an email automatically created by Excel using VBA, with subject, recipient, message body with template text all filled in.
Sub CreateMail(Optional sFile As String = "")
'Create email to send to requestor with attachment sFile
'Declarations
Dim app As Outlook.Application
Dim msg As Outlook.MailItem
Dim send_to As Recipient
Dim send_tos As Recipients
'Initiations
Set app = CreateObject("Outlook.Application")
Set msg = app.CreateItem(olMailItem)
Set send_tos = msg.Recipients
Set send_to = send_tos.Add("receiver#email.com")
send_to.Type = 1
'Create message
With msg
.SentOnBehalfOfName = "sender#email.com"
.Subject = "This is the email subject"
.HTMLBody = "This is the email body" & vbCrLf
'Resolve each Recipient's name.
For Each send_to In msg.Recipients
send_to.Resolve
Next
If Len(sFile) > 0 Then
.Attachments.Add sFile
End If
.Display
End With
End sub
After making some manual changes to the email that is created, we'd like to send it and have a copy saved to a folder on the file system automatically (in addition to the usual sent folder in Outlook). Is there a way to do this all within Excel VBA?
I suspect it might be possible using Outlook VBA, however the folders are defined in Excel and we'd like to keep the code together in the one file.
What is your code for sending email? This works for me in an Excel VBA module:
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "email address"
.Subject = "Test"
.HTMLBody = "Test " & Now
.DeleteAfterSubmit = True 'to not retain in sent folder
.Display
.SaveAs "C:\filepath\Test.txt", 0
' .Send
End With
However, guess the real trick is allowing edit of the email before saving file. So far not seeing solution for that. Unfortunately the code execution does not pause while the message window is open. I was hoping for the pause since Office is supposed to be an integrated suite of apps - like opening a form in Access in dialog mode which does pause execution of code.
With code in Excel only, monitor the SentItems folder.
Utilizing Outlook Events From Excel
Confirm the mail from a unique ID.
The unique ID could be in the subject or body.
You could try saving the unique ID in PR_SEARCH_KEY. It is the same idea How, can get the exact sent Email from Sent Items folder? and How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved

E-Mail body is lost when sending (outlook vba)

I'm trying to write a macro that sends an automatic notification to specific addresses before sending the original email. (Like a cc, without actually using cc.)
The content of the original formatted email, (including text, tables, and pictures,) should be copied and pasted into a new email which is then automatically sent. Everything works when I just display the message, but not when actually sending the email.
Here is my code:
Dim objMsg As Outlook.MailItem
Dim activeMailMessage As Outlook.MailItem
Dim BodyText As Object
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'set up and send notification email
With objMsg
.To = "test#domain.com"
.Subject = "text"
.Send
End With
The text should be pasted into the body like this, but it won't paste:
With objMsg
.To = "test#domain.com"
.Subject = "test"
.body = bodytext.paste
.Send
End With
When I use .display the correct content is displayed. But when I send it directly (without first using .display), all of all information is lost and an empty email is sent. What can I do?
I could add a bcc in the original email to achieve the same result, but the original email does not always send, whereas this notification should be.
Your code is never actually setting the Body of the e-mail in the objMsg object. It is working when you have objMsg displayed because your interacting with the 'Inspector'.
If you directly set either the HTMLBody (if you want to retain formatting), or the Body property on objMsg then it will work as in the below example.
With objMsg
.HTMLBody = activeMailMessage.HTMLBody
.To = "test#domain.com"
.Subject = "text"
.Send
End With
Bob, regarding your question on images that are embedded within the e-mail being lost with the above approach. An alternate solution could be to use the MailItem's Copy method to create your new MailItem exactly as the original Item. This will also retain who the e-mail is being sent to you need to clear this to make sure only the intended recipients receive it.
Dim objMsg As Outlook.MailItem
Dim activeMailMessage As Outlook.MailItem
' Create the new message.
Set objMsg = Application.CreateItem(olMailItem)
' Assign the current item to activeMailMessage
Set activeMailMessage = ActiveInspector.CurrentItem
' Copy the current item to create a new message
Set objMsg = activeMailMessage.Copy
' Clear any existing recipients of the e-mail, as these will be retained in the Copy
While objMsg.Recipients.Count > 0
objMsg.Recipients.Remove 1
Wend
'set up and send notification email
With objMsg
.To = "test#domain.com"
.Subject = "text"
.Send
End With
This should retain your images and other attachments as they were in the original e-mail.
Try to call the Save method after calling the Paste method.