Attaching embedded xl sheet into Outlook in VBA - excel

I am trying to attach the embedded xl object into outlook mail in vb.
my existing code is
Sheets("Doc Repository").Shapes.Range(Array("Object 1")).Select
Selection.Copy
Here "Doc Repository" is a sheet which has embedded .zip file.
with the above code, Object 1(zip folder) is getting copied to clipboard.
I am not sure how to paste the the copied zip file into outlook mail.

I'd suggest saving the zip file to the disk and then add it as an attachment to the MailItem object using the Add mehtod of the Attachments class (see the corresponding property of the MailItem class).
Sub AddAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "D:\Test.zip", _
olByValue, 1, "Test"
myItem.Display
End Sub

Related

How to write a macro that send excel as a pdf to outlook web based not app based

I have a macro that creates a pdf and then send it to outlook to attach as a email but it tries to open the app instead of using the web based version. what code can I use to replace it with?
You need to save the workbook on the disk and then use the file path of the just saved file to add it as an attachment in Outlook. The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment. For example:
Sub AddAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "D:\Test.xlsx", _
olByValue, 1, "Test"
myItem.Display
End Sub
The code for automating Outlook desktop will not work for the browser out of the box.

Copy PowerPoint native table to the body of an Outlook Email

I cannot provide all the code. It is from an internal project of my company.
I created VBA code to take elements from an Excel list and save it in a PowerPoint native table (dimensions: 7 rows, 6 columns, name: Table1), which is already created inside of the PowerPoint template file. The code only fills it with the correct data in the correct cells.
'Example of how I access the native table in PowerPoint
Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
'I can get data from a cell by using, for example:
oPPTShape.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text
'But I cannot select a range from this PowerPoint table
I would like to extract this native table from PowerPoint and paste it in an Outlook email's body. I read that maybe I can do this by using .HTMLBody = StrBody & RangetoHTML(rng), inside of the OutMail as described below:
With OutMail
.To = name_email
'Add file
.Attachments.Add ("C:... .pptx")
.Subject = "Data"
.Body = StrBody
.HTMLBody = StrBody & RangetoHTML(rng)
.SaveAs "C:... .msg", 5
.Display 'Or use .Send
End With
Where rng is the Range that will be copied from the Table1 inside of the email's body.
Until now I can use the data from PowerPoint Table1 with the code below and I was trying to use the same method to insert the Table1 in the email's body.
Dim strNewPresPath As String
strNewPresPath = "C:\... .pptx"
Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue
Set oPPTFile = oPPTApp.Presentations.Open(strNewPresPath)
SlideNum = 1
Sheets("Open Tasks").Activate
Dim myStr As String
myStr = "Open"
Do
oPPTFile.Slides(SlideNum).Select
'Select PowerPoint shape with the name Table1
Set oPPTShape = oPPTFile.Slides(SlideNum).Shapes("Table1")
.
.
.
My question is:
Is there another way to copy and paste this Table1 from PowerPoint to the email's body with VBA code?
It can be as an Image/Picture from the Table or even not in the same exact format that it is in PowerPoint, because until now I am sending it as an attachment file and I believe it is easier to read when the Table is visible under the text written in the email.
Here is a basic example that will take a PowerPoint Table and copy it over to an outlook email using early binding.
Keep in mind this can be volatile at times, in other words, the information doesn't actually make it to the clipboard but this can be dealt with by pausing the application for a few seconds. Also, this will work if Outlook is ALREADY OPEN.
Sub ExportToOutlook()
'Declare PowerPoint Variables
Dim PPTShape As PowerPoint.Shape
'Declare Outlook Variables
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
'Create a reference to the table you want to copy, & select it.
Set PPTShape = ActivePresentation.Slides(1).Shapes("Table 1")
PPTShape.Select
On Error Resume Next
'Test if Outlook is Open
Set oLookApp = GetObject(, "Outlook.Application")
'If the Application isn't open it will return a 429 error
If Err.Number = 429 Then
'If it is not open then clear the error and create a new instance of Outlook
Err.Clear
Set oLookApp = New Outlook.Application
End If
'Create a mail item in outlook.
Set oLookItm = oLookApp.CreateItem(olMailItem)
'Copy the table
PPTShape.Copy
'Create the Outlook item
With oLookItm
'Pass through the necessary info
.To = "Someone"
.Subject = "Test"
.Display
'Get the word editor
Set oLookInsp = .GetInspector
Set oWdEditor = oLookInsp.WordEditor
'Define the content area
Set oWdContent = oWdEditor.Content
oWdContent.InsertParagraphBefore
'Define the range where we want to paste.
Set oWdRng = oWdEditor.Paragraphs(1).Range
'Paste the object.
oWdRng.Paste
End With
End Sub

Attaching unsaved Excel file to email

I have an Excel form for users to fill and send as an attachment (without having to save it locally on their computer).
The code works.
Dim Names()
Names = Array("testmail#gmail.com")
ActiveWorkbook.SendMail _
Recipients:=Names(), _
Subject:="Test subject"
I would like the email just to be created and not sent until the users have attached an additional file (found on their local computer).
I wrote the following code:
Dim olapp As Object
Dim olmail As Object
Dim wb As Workbook
Set olapp = CreateObject("outlook.application")
Set olmail = olapp.CreateItem(olMailItem)
Set wb = ActiveWorkbook
With olmail
.To = "testmail#gmail.com"
.Subject = "Test Subject"
.Body = ""
.Attachments.Add wb.FullName
.Display
My problem is that only the latest saved copy will be attached to the created email, and since the users will not have the form/Excel file stored locally on their computer, an empty form (or the last saved form) will be attached to the email.
Is there any way for an email to be created, with a copy of the workbook, but not to send it?
i tried this one-liner in the immediate window and it managed to send an unsaved file: Application.Workbooks("Book2").SendMail("my.email#company.com","Test Subject") you can use wb from your code instead of Application.Workbooks("Book2") in my example. Note that this will send the email, without the possibility to edit it.

MailItem.GetInspector.WordEditor in Office 2016 generates Application-defined or object defined error

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 & ")"
...

VBA open workbook attached to outlook template

Is there any way that one can open a workbook attached to an email template, edit, and save it prior to sending the message? I've created the mailitem object using Set Mesg = OutlookAp.CreateItemFromTemplate("C:\Template.oft") and I can see the attachment, but I can't see a way to open it thus far. If anyone has suggestions, or knows that this simply can't be done, I'm all ears.
Looks like I may have to save and edit the file prior to sending... Still open to ideas, but it looks like it simply isn't possible to open the attachment through VBA
I assume you are automating Outlook from Excel. This solution may work for you, but as you note it does rely on saving the attachment and re-attaching the manipulated version of the file. Assuming you can write the code which will "edit" the Workbook attachment, this should work for you.
Sub TestOutlookTemplate()
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim att As Outlook.Attachment
Dim templatePath As String
Dim tempFileName As String
Dim attWorkbook As Workbook
templatePath = "C:\users\david_zemens\desktop\Untitled.oft"
tempFileName = "C:\users\david_zemens\desktop\tempexcelfile.xlsx"
Set MyOutlook = CreateObject("Outlook.Application")
Set MyMail = MyOutlook.CreateItemFromTemplate(templatePath)
MyMail.Display
For Each att In MyMail.Attachments
If att.DisplayName Like "*.xls*" Then
att.SaveAsFile tempFileName
'Now that you have saved the file, delete the attachment
att.Delete
'Open the file
Set attWorkbook = Workbooks.Open(tempFileName)
'Perform manipulation on the file
attWorkbook.Sheets(1).Name = "Sheet ONE"
'Save fhe file
attWorkbook.Save
'Close the file
attWorkbook.Close
MyMail.Attachments.Add tempFileName
End If
Next
'Send your mail (make sure you have added a recipient
MyMail.Send
Set attWorkbook = Nothing
Set MyMail = Nothing
Set MyOutlook = Nothing
End Sub

Resources