I send emails via Outlook using ".HTMLBody = ..." to customize body.
I tried to add these lines to add an image that I named "logo" in the worksheet:
With Sheets("Mail - GREF COMMITTEE AGENDA")
.Shapes("logo").Export "C:\Users\Public\Pictures\logo.png"
End With
'...
.HTMLBody = bodyEn & bodyFR & "< img src='C:\Users\Public\Pictures\logo.png'>"
The error is:
438 Object doesn't support this method or property.
Update: Any way to embed the image in the mail is helpful. I can export the image manually.
Use Word's InlineShapes.AddPicture Method
The procedure is described in Working with Item Bodies.
Inserting pictures:
strFile = "C:\Pictures\logo.gif"
Set objInsp = objMsg.GetInspector
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Windows(1).Selection
If objMsg.BodyFormat <> olFormatPlain Then
objSel.InlineShapes.AddPicture strFile, False, True
End If
Related
I've written a macro in Excel to send calendar invites (appointments) via Outlook. The recipients must be bcc'd (added to Resources field).
I have text in the body of the calendar appointment. It appears that by utilizing the WordEditor in combination with bcc/resources, I get an alert pop-up before each send: "Do you want to update the location to...?"
I do not want to update/change the location, as it would get replaced by the recipient list, thus defeating the reason for bcc (recipients would see Location as the entire recipient list).
If I remove the code block that adds text to the body (starting with "Set ActInsp..."), then this alert does not appear, and everything else works correctly; however, I need the text body with a hyperlink.
gif of how to duplicate the "Update Location" alert manually.
Below is a working sample of the macro. The code block with WordEditor appears toward the bottom, right above .Display.
Be sure to add the Reference: Microsoft Outlook 16.0 Object Library (I failed to get late binding to work).
Sub SendAppointments_SingleEmail()
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
'Requires early binding (late binding not working):
' Go to the Tools menu, Resources. Add Microsoft Outlook 16.0 Object Library
'Because AppointmentItem does not use HTML, must utilize Word VBA
Dim ActInsp As Outlook.Inspector
'Static fields
emailFrom = "test#gmail.com"
emailSubject = "My Subject"
emailBody = "Body of calendar invite"
hyperlink = "https://www.register.com/"
emailLocation = "My Location"
appt_Date = #7/30/2019#
appt_Time = #3:00:00 PM#
appt_Duration = "90"
'Create Appointment and Send
Set myAppt = olApp.CreateItem(olAppointmentItem)
With myAppt
.MeetingStatus = olMeeting
.SendUsingAccount = emailFrom
.Subject = emailSubject
.Location = emailLocation
.Start = appt_Date & " " & appt_Time
.Duration = 90
Set myResourceAttendee = .Recipients.Add("test1#test.com")
myResourceAttendee.Type = olResource 'Add as a Resource/BCC
Set ActInsp = myAppt.GetInspector
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & hyperlink)
.Close (olSave)
End With
.Display
'.Send
End With 'myAppt
End Sub
Instead of Closing the Object from ActInsp, Close the myAppt object.
So change this part of your code:
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & hyperlink)
.Close (olSave)
End With
.Display
'.Send
With:
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & Hyperlink)
'.Close (olSave)
End With
.Display
.Close (olSave)
'.Send
I am trying to create an Outlook email draft with an inline pdf document.
I managed to add inline pictures using html img src tag but this does not work for documents. What should I modify to add pdf instead of images?
I tried using the position but does not add in the correct position instead adds to the end of text.
Set outlook = createObject(“Outlook.Application”)
Set mailItem = outlook.CreateItem(olMailItem)
With mailItem
.BodyFormat = olFormatRichText
.Body = “hello world”
.Attachments.add “file.pdf”, olByValue, 6
End With
You can only do that in the RTF format, not in HTML. When calling MailItem.Attachments.Add, specify the Position parameter appropriately.
It seems like the add function only works after you call display, else it will only add to the end of the entire body
Set outlook = createObject(“Outlook.Application”)
Set mailItem = outlook.CreateItem(olMailItem)
With mailItem
.BodyFormat = olFormatRichText
.Body = “hello world”
.Display
.Attachments.add “file.pdf”, olByValue, 6
End With
I am trying to create a macro which will open a new lotus notes mail, attaches certain files to it and copy and paste the body from a stationery mail.
I am stuck in the last part where I have to copy the BODY of the stationery mail and paste it in the new mail which I have created.
Below is the code which I have tried, but only the files are getting attached but unable to copy the body from the stationery
Any Help is appreciated........
isattached = False
Application.ScreenUpdating = False
'Start Lotus Notes Session
Set nSession = CreateObject("Notes.NotesSession")
On Error GoTo err_send
Set nMailDb = nSession.GetDatabase("", "mailin/GBG180.nsf")
' Open the Stationery View
Set nView = nMailDb.GetView("Stationery")
Set nWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set nCursor = nView.GetFirstDocument
Do While Not nCursor Is Nothing
' get stationery value
StationeryName = nCursor.GetItemValue("MailStationeryName")(0)
' match form template selection versus stationery
If StationeryName = St_name Then
Set nMailDoc = nMailDb.CreateDocument("Memo")
Set AttachME = nMailDoc.CreateRichTextItem("ATTACHMENT")
'Open the PDF folder and attach the files
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(PdfPath)
For Each objFile In objFolder.Files
Set EmbedObj = AttachME.EmbedObject(1454, "", PdfPath & objFile.Name)
isattached = True
Application.Wait (15)
Next
subjectname = policy_num & "-" & aname & "-FoS Invoice & Wording" & " " & Format(DateValue(Now()), "YYYY") & "- Confidential"
If (isattached) Then
'Set nMailDoc = nWorkspace.EDITDOCUMENT(True, nCursor)
nMailDoc.Subject = subjectname
Else
Set nMailDoc = Nothing
Set AttachME = Nothing
Exit Function
End If
nMailDoc.Save True, True, False
Set nMailDoc = Nothing
Set nCursor = Nothing
GoTo nMail_OK
Else
Set nCursor = nView.GetNextDocument(nCursor)
End If
Loop
In Domino there are Default item names to store data in. The Body (inlcuding all attachments) in a mail is always called "Body", and not "ATTACHMENTS" as in your example.
You need to replace these lines
Set AttachME = nMailDoc.CreateRichTextItem("ATTACHMENT")
'Open the PDF folder and attach the files
...
with these
Dim bodyStationary as NotesRichtextItem
'- get the richtext from the stationary
Set bodyStationary = nCursor.GetFirstItem( "Body" )
'- create richtextitem in new document
Set AttachME = nMailDoc.CreateRichTextItem("Body")
'- append the stationary
Call AttachMe.AppendRTItem( bodyStationary )
'- add the attachments
'Open the PDF folder and attach the files
...
If you want to have the attachments above the text of the stationary, just move the AppendRTItem below the Foreach- loop.
Don't forget to add Attachme.AddNewline( 2 ) in that case, as otherwise the text will directly follow the attachments.
I created a macro in Excel to send emails to various users every time a specific file is updated.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim answer As String
answer = MsgBox("Would you like to save the changes?", vbYesNo, "Save Document")
If answer = vbNo Then Cancel = True
If answer = vbYes Then
'open outlook type stuff
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
'add recipients
'newmsg.Recipients.Add ("Name1")
newmsg.Recipients.Add ("email#xxx.com")
'newmsg.Recipients.Add ("Name2")
newmsg.Recipients.Add ("email#xxx.com")
'add subject
newmsg.Subject = "Notification - Update file"
'add body
newmsg.Body = "This is an automated notification." & vbNewLine & vbNewLine & _
"The XXX file has been recently updated" & vbNewLine & vbNewLine & _
"Please do not reply to this email."
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "Your document has successfully been saved", , "Confirmation"
End If
'save the document
'Me.Worksheets.Save
End Sub
I would like to add a hyperlink to the body text where it says "The XXX file has been recently updated" so that XXX file is a clickable link to a website.
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
The last two supports creating a hyperlink in the message body. It is up to you which way is to choose.
If you want to do that, you'll have to write HTML instead of plain text.
This line:
newmsg.Body = "The XXX file has been recently updated"
... would become something like:
newMsg.HTMLBody = "The XXX file has been recently updated".
This is because in Outlook emails with formatting you write HTML text, and a link in HTML is expressed as follows:
your Hyper-text
I wrote an Excel macro to send email from a spreadsheet. It works on Office 2013, but not Office 2016.
I looked at the VBA differences between Office 2013 and 2016, but couldn't see anything about changes to the inspector or word editor for message objects.
Once it gets to .GetInspector.WordEditor it throws:
Run-time error '287':
Application-defined or object defined error
Here is the relevant part of the macro:
Sub SendEmail()
Dim actSheet As Worksheet
Set actSheet = ActiveSheet
'directories of attachment and email template
Dim dirEmail as String, dirAttach As String
' Directory of email template as word document
dirEmail = _
"Path_To_Word_Doc_Email_Body"
' Directories of attachments
dirAttach = _
"Path_To_Attachment"
' Email Subject line
Dim subjEmail As String
subjEmail = "Email Subject"
Dim wordApp As Word.Application
Dim docEmail As Word.Document
' Opens email template and copies it
Set wordApp = New Word.Application
Set docEmail = wordApp.Documents.Open(dirEmail, ReadOnly:=True)
docEmail.Content.Copy
Dim OutApp As Outlook.Application
Set OutApp = New Outlook.Application
Dim OutMail As MailItem
Dim outEdit As Word.Document
' The names/emails to send to
Dim docName As String, sendEmail As String, ccEmail As String, siteName As String
Dim corName As String
Dim row As Integer
For row = 2 To 20
sendName = actSheet.Cells(row, 1)
sendEmail = actSheet.Cells(row, 2)
ccEmail = actSheet.Cells(row, 3)
siteName = actSheet.Cells(row, 4)
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
outEdit.Range(0).InsertBefore ("Dear " & sendName & "," & vbNewLine)
.Attachments.Add dirAttach
.Display
'.Send
End With
Debug.Print row
Set OutMail = Nothing
Set outEdit = Nothing
Next row
docEmail.Close False
wordApp.Quit
End Sub
Things I've tried based on suggestions:
Checked Outlook settings - default is HTML text
Moved .display over .GetInspector.WordEditor
Ensure Word is the default email editor. From the Inspector.WordEditor dox:
The WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord . The returned WordDocument object provides access to most of the Word object model...
Further, ensure that Outlook is configured to send Rich Text or HTML emails, not plain text.
I am not entirely sure if I had the same issue as you, but the call to GetInspector started failing for me after upgrading Office 2016. So to be clear it worked with Office 2016 and then stopped working after the latest update.
The following workaround worked for me
dim item : set item = Addin.Outlook.CreateItemFromTemplate(Filename)
Outlook.Inspectors.Add(item) ' Outlook is the application object
it only appears to work if I add the item straight after creating it, setting properties on it and then adding it did not work.
Note: I have not tested with CreateItem instead of CreateItemFromTemplate. The second line was added and unnecessary prior to the Office update.
Problem:
For security purposes, the HTMLBody, HTMLEditor, Body and WordEditor properties all are subject to address-information security prompts because the body of a message often contains the sender's or other people's e-mail addresses. And, if Group Policy does not permit then these prompts do not come on-screen. In simple words, as a developer, you are bound to change your code, because neither registry changes can be made nor group policy can be modified.
Hence, if your code suddenly stopped working after migrating to Office 365 or for any other reasons, please refer to the solutions below. Comments have been added for easy understanding and implementation.
Solution 1:
If you have administrative rights then try the registry changes given at below link:
https://support.microsoft.com/en-au/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
However, as developer, I recommend a code that's rather compatible with all versions of Excel instead of making system changes because system changes will be required on each end user's machine as well.
Solution 2: VBA Code
Code Compatible: Excel 2003, Excel 2007, Excel 2010, Excel 2013, Excel 2016, Office 365
Option Explicit
Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)
Dim rngToPicture As Range
Dim outlookApp As Object
Dim Outmail As Object
Dim strTempFilePath As String
Dim strTempFileName As String
'Name it anything, doesn't matter
strTempFileName = "RangeAsPNG"
'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
Set rngToPicture = Range("rngToPicture")
Set outlookApp = CreateObject("Outlook.Application")
Set Outmail = outlookApp.CreateItem(olMailItem)
'Create an email
With Outmail
.To = strTo
.Subject = strSubject
'Create the range as a PNG file and store it in temp folder
Call createPNG(rngToPicture, strTempFileName)
'Embed the image in Outlook
strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
.Attachments.Add strTempFilePath, olByValue, 0
'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
.HTMLBody = "<img src='cid:DashboardFile.png' style='border:0'>"
.Display
End With
Set Outmail = Nothing
Set outlookApp = Nothing
Set rngToPicture = Nothing
End Sub
Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
Dim wksName As String
wksName = rngToPicture.Parent.Name
'Delete the existing PNG file of same name, if exists
On Error Resume Next
Kill Environ$("temp") & "\" & nameFile & ".png"
On Error GoTo 0
'Copy the range as picture
rngToPicture.CopyPicture
'Paste the picture in Chart area of same dimensions
With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
.Activate
.Chart.Paste
'Export the chart as PNG File to Temp folder
.Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
End With
Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete
End Sub
Try moving the editor to the first action...
...
With OutMail
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
...