I got a*.xls file which contains a plugin generated shapes which forms a chart.
How can I send those shapes as an image acompany with some text in a email using VBA?
I know how to get the shapes in VBA, but don't know how to convert them into a single image.
FYI: I can not install any software or programming environment on my working computer. MS Office is only what I've got.
Excel Vba has a CopyPicture Method on the chart object that you can use to copy a chart to the clipboard and then paste to the image into a new email. I will post a quick demo when I get the chance, but hopefully this will point you in the right direction. Also look at this question as it may help as well.
EDIT
Found that you can also Export a chart as an image.
Try this, I have tested this and it does work.
Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim myChart As ChartObject
Set myChart = Me.ChartObjects(1)
Dim myFilename As String
myFilename = "c:\temp\test.png"
On Error Resume Next
Kill myFilename
On Error GoTo 0
myChart.chart.Export myFilename, "PNG"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "test#test.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add myFilename
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Related
I created code to copy a cell range into an email.
A) This gets me an image where the text is blurry and overly bold
.PasteandFormat wdChartPicture
B) This gets me the correct text clarity but I need to zoom the email itself to x300 to visualize the numbers and letters clearly
.PasteandFormat wdMatchDestinationFormatting
How can I paste in a size that is clear to visualize?
Alternatively how can I increase the pasted image so that the recipient doesn't have to zoom x300 to see the email?
Option Explicit
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim wb As Workbook, ws As Worksheet, wsSettings As Worksheet
Dim wordDoc
Dim strHTMLBody As String
Dim lonZoom As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set wb = ThisWorkbook
Set wsSettings = wb.Worksheets("Settings")
'grab table, convert to image, and cut'
Set ws = ThisWorkbook.Sheets("Summary")
Set table = ws.Range("B8:AA338")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
'create email message'
On Error Resume Next
With OutMail
strHTMLBody = strHTMLBody & "</span>"
.HTMLBody = strHTMLBody
.To = wsSettings.Range("Email_To").Value
.Subject = wsSettings.Range("Email_Subject").Value
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.PasteandFormat wdMatchDestinationFormatting
End With
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
You deal with a message body which is an HTML markup. So, you can save the generated image in Excel as a file and then attach it to the mail item and use in the body markup in the way you like.
The Attachments.Add method allows to attach a file. But you need to use an embedded image (not visible attachments). You need to set up the CID property on the attachment and use the CID attribute in the HTML markup.
Refer to the image in the HTML body through the cid attribute
<img src="cid:xyz">
Then add the attachment using Attachments.Add.
After that you can set the PR_ATTACH_CONTENT_ID property (DASL name http://schemas.microsoft.com/mapi/proptag/0x3712001F) using Attachment.PropertyAccessor.SetProperty. This will be your cid value.
I am trying to copy all of content of a word doc into a Outlook email body while keeping the format and was looking to follow the solution found on this post but am getting an error on the following line: .BodyFormat = olFormatRichText. When the error handler is removed, I get RTE5: Invalid procedure call or argument
Any idea why this line is throwing an error or how to correct?
Sub Sender(Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim wd As Object
Dim editor As Object
Dim doc As Object
Dim fp As String
fp = "C:\Users\urdearboy\"
Set wd = CreateObject("Word.Application")
Set doc = wd.documents.Open(fp & "mydearfile.docx")
doc.Content.Copy
doc.Close
Set wd = Nothing
On Error GoTo BNP:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = "urdearboy#so.com"
.to = Target.Offset(, 2)
.Subject = "Hi Mom"
.BodyFormat = olFormatRichText '<----- ERROR LINE
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
'.Send
Target.Offset(, -1) = "Sent"
End With
BNP:
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
Context: I decided to go with the Word to Outlook copy because the file has a lot of formatting and photos and getting the right format strictly in Outlook HTML sounds like a nightmare. If done manually, this would essentially be a complete CTRL + A + Copy from word and CTRL + V in Outlook which keeps all formatting, photos, and gifs with correct format. The goal here is to mimic that process in VBA. If there is a better solution, open to thoughts there as well
If you're late-binding, then add:
Const olFormatRichText As Long = 3
(seems like you didn't have Option Explicit on too...)
You can find the appropriate value of olFormatRichText here.
I'm using the below code to auto-generate an email.
Public Function GenerateEmail(sendToText As String, _
sendCCText As String, sendBCCText As String, _
subjectText As String, fileName As String)
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(fileName)
With OutMail
.sendTo = sendToText
.CC = sendCCText
.BCC = sendBCCText
.Subject = subjectText
.HTMLbody = WorksheetFunction.Substitute(OutMail.HTMLbody, "%TESTNUM%", "98541")
.Attachments.Add (Application.ActiveWorkbook.FullName)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
My end goal is to add data into the email and attach the active document into it as well. Everything here is working as intended, except the .HTLMbody section. It's giving me an error
"Unable to get the Substitute property of the WorksheetFunction
class."
Am I missing a reference to a library? Should I be using something different?
The email is saved as .oft format, so I have a line in the email that has %TESTNUM% that I'm looking to replace with 98541 (or any other string I need to pass into the function)
I have HTML email working in Excel using very similar code. The difference is that I build a temporary string with the text and you could do your substitute code on the string.
Then you can simply use:
.HTMLbody = temp_string
It might not be as elegant but it will help you work out where the problem is.
I'm upgrading an Excel macro. I want to generate an email copying in a table that changes range daily.
Strbody populates the email but the timetable isn't attaching.
Sub Ops_button()
'Working in Office 2000-2010
Dim Outapp As Object
Dim Outmail As Object
Dim Strbody As String
Dim Timetable As String
'Auto Email Attachment Variables
Set Outapp = CreateObject("Outlook.Application")
Set Outmail = Outapp.createitem(0)
Timetable = Sheets("sheet1").Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Strbody = "body text."
On Error Resume Next
With Outmail
'Send email
.To = ""
.bcc = ""
.Subject = "Report" & " " & Format$(Date, "dd-mm-yyyy")
.body = Strbody & Timetable
On Error Resume Next
.Display
End With
On Error GoTo 0
Set Outmail = Nothing
Set Outapp = Nothing
End Sub
You can't do this the way you're trying to do it... Let's see why not :)
You've declared Timetable as a String type variable. In this statement, you're assigning its value as the return from the .Select method (which will return a value of True if there is no error).
Timetable = Sheets("sheet1").Range("C2").Select
So, you're in no way appending the Table's Range object to the string, in this statement:
.body = Strbody & Timetable
Instead, you really need to either convert the table to HTML or copy and paste the range directly from Excel to Word.
Use Ron de Bruin's function to convert the table to an HTML PublishObject and insert that to the email, or
.Display the MailItem and then get a handle on the MailItem's .Inspector object (which is really just a Word document)
For the solution 1, adapt the answer already given, here:
Paste specific excel range in outlook
For the solution 2, you'll need to use the method outlined here to get the Inspector (Word Document representing the Email item):
https://msdn.microsoft.com/en-us/library/office/ff868098.aspx
Then, Dim TimeTable as Range, and change code to:
Set Timetable = Sheets("sheet1").Range("C2").End(xlToRight).End(xlDown)
Then, copy the table:
Timetable.Copy
And then following the MSDN link above once you have a handle on the Inspector, get the destination range in Outlook (Word) and you can use the PasteAndFormat method of a Word.Range object:
Dim wdRange as Object 'Word.Range
OutMail.Display
Set wdRange = OutMail.getInspector().WordEditor.Range
wdRange.Text = strBody
wdRange.Expand (1)
wdRange.Characters.Last.PasteAndFormat 16 'wdFormatOriginalFormatting
Option 2 would be my preferred method. I'm on a computer that doesn't have outlook, so I'm winging this a little bit from memory and I can't test right now, but if you have any issues with it just leave a comment and I'll try to help out some more in the morning.
Im using the following code and its been working fine. i have updated to a surface pro and know my macro have stop working.
i think it has some think to do will this line in
Set OutApp = CreateObject("Outlook.Application")
With window 8 i don't think it uses outlook anymore
Has any one else had this problem
Full code below
Private Sub CommandButton21_Click()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "help#hiall.com.au"
.CC = ""
.BCC = ""
.Subject = "Inspection"
.Body = "Inspection n"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
What Outlook version do you have installed on the PC? Did you check out the Trust Center settings in Outlook?
In general, your code is correct, I don't see anything strange... The How to automate Outlook from another program article describes the required steps for automating Outlook.
Be aware, the Click2Run edition of Office 2010 doesn't support automation. Also you may find the You receive run-time error 429 when you automate Office applications article helpful.