I'm really fresh to VBA as a whole and have a very general concept of how to read the scripting
I've frankensteined together some code that mostly does what I need, but I'm having a formatting issue with one section of my code.
I'm sure it's a single line that I'm just not plugging in right, but I've tried a handful of different methods that I haven't been able to implement..
Here's the section that does everything I need except the center alignment:
'Copy contents
Sheets("Tables").Select
Range("J6:R145").Select
Range("J6").Activate
Selection.Copy
'Open new mail item
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Set outMail = outlookApp.CreateItem(0)
'Get Word editor
outMail.Display
Dim wordDoc As Object
Set wordDoc = outMail.GetInspector.WordEditor
'Paste as image
wordDoc.Range.PasteAndFormat Type:=wdChartPicture
wordDoc.Range.Select
Selection.Rows.Alignment = wdAlignRowCenter
Current Result:
Failed Debug Step
I'm betting it's a matter of bad syntax but here's what I've plugged in so far:
Selection.PageSetup.CenterHorizontally = True
Selection.HorizontalAlignment = xlCenter
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
and the above-listed Rows.Alignment
All have failed out at this line rather than centering the object
Any help would be appreciated!
PS: Bonus points if you can teach how to keep it from deleting the email signature when it pastes
Try this
Public Sub pastetable()
'Copy contents
Sheets("Tables").Select
Range("J6:R145").Select
Range("J6").Activate
Selection.Copy
'Open new mail item
Dim outlookApp As Object
Set outlookApp = CreateObject("Outlook.Application")
Set outMail = outlookApp.CreateItem(0)
'Get Word editor
outMail.Display
Dim wordDoc As Object
Set wordDoc = outMail.GetInspector.WordEditor
'Paste as image
wordDoc.Range.InsertParagraphBefore 'Create new empty paragraph before signature
wordDoc.Paragraphs.first.Range.PasteAndFormat Type:=wdChartPicture
With wordDoc.Tables(1).Rows
.WrapAroundText = 0 'If this is true does not work
.Alignment = 1
End With
End Sub
Related
I am working on an excel macro to send a series of emails each with a unique attachment, and one of three template emails that are saved as word documents. Everything is working well, except pulling the body of the email in from the word document. The problem seems to be with WordEditor. I get the following error
Err.Description:The operation failed.
Err.Number:-2147467259
Err.Source:Microsoft Outlook
Here is the code I have tried:
Sub SendDCLEmails()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim DCLFile As String 'Attachment that differs for each email
Dim DCLCount As Integer 'Number of emails that will be sent
Dim toList As String
Dim ccList As String
Dim CoverLetter As String 'Word document template email
Dim fileCheckDCL As String
Dim fileCheckCover As String
Dim editor As Object
'Set references to Outlook
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
On Error GoTo 0
'Set references to Word
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then Set WordApp = New Word.Application
On Error GoTo 0
Sheets("Contacts").Select
'Create email for each record on "Contacts" tab
DCLCount = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To DCLCount
DCLFile = Range("AD1").Offset(i, 0).Value & "\" & Range("AE1").Offset(i, 0).Value
CoverLetter = Range("AF1").Offset(i, 0).Value
fileCheckDCL = Dir(DCLFile)
fileCheckCover = Dir(CoverLetter)
'Run some validations and generate the toList and ccList variables.
Set WordDoc = WordApp.Documents.Open(CoverLetter)
WordDoc.Content.Copy
'Create Emails
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = toList
.CC = ccList
.Subject = Range("AG1").Offset(i, 0).Value
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
editor.Content.Paste
.Attachments.Add DCLFile
.Send
End With
WordDoc.Close savechanges:=False
End If
toList = vbNullString
ccList = vbNullString
CoverLetter = vbNullString
DCLFile = vbNullString
fileCheckDCL = vbNullString
fileCheckCover = vbNullString
Set editor = Nothing
Next i
OutlookApp.Quit
WordApp.Quit
End Sub
There is no need to use late and early-binding technologies in the VBA macros:
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
Instead, you need to use one or another. Read more about that in the Using early binding and late binding in Automation article. I'd suggest declaring all objects with real classes (early-binding), it may allow avoiding mistakes with syntax further. And use the New operator in the code instead of CreateObject one.
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
Calling the WordEditor property may sometimes fail if the Inspector is not yet visible and initialized. Try to call the Display method prior getting the Word editor value.
Also instead of relying on Word documents as templates you may create templates in Outlook and use the Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. Read more about that in the article which I wrote for the technical blog, see How To: Create a new Outlook message based on a template.
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 have a daily task to copy a range of cells into an email.
I managed to do this, with the range being formatted as a photo. (I learnt that copying a range in table format isn't as straight forward as it seems).
How do I code the size and format of the photo produced, height: 9cm, width: 28cm, format as square?
I think I need to do this via the Word editor. I tried .style.width but it throws an error.
Sub email()
Dim ol As Object 'Outlook.Application
Dim olEmail As Object 'Outlook.MailItem
Dim olInsp As Object 'Outlook.Inspector
Dim wd As Object 'Word.Document
Sheets("Daily message").Range("B3:L21").SpecialCells(xlCellTypeVisible).Copy
Set ol = GetObject(, "Outlook.Application") '/* if outlook is running, create otherwise */
Set olEmail = ol.CreateItem(0) 'olMailItem
With olEmail
Set olInsp = .GetInspector
If olInsp.EditorType = 4 Then 'olEditorWord
Set wd = olInsp.WordEditor
wd.Range.PasteAndFormat 13 'wdChartPicture
End If
.To = "my email"
.BCC = ""
.Subject = "Daily message"
.Display
End With
End Sub
You can use the HTMLBody property to format the pasted image and the message body in general.
There are three main ways for setting the body of Outlook items:
The Body property (a plain text).
The HTMLBody property - allows customizing the body using the HTML markup as shown above.
The Word object model. Outlook uses Word as an email editor by default. The WordEditor property of the Inspector class returns an instance of the Document class which represents the body.
You can read more about these ways in Chapter 17: Working with Item Bodies.
In HTML you can use the style attribute to specify the width and height of an image.
<img src="img1.jpg" style="width:500px;height:600px;">
Alternatively, you can use the width and height attributes:
<img src="img2.jpg" width="500" height="600">
The width and height attributes always define the width and height of the image in pixels.
Managed to get this to work!
Sub RangeToOutlook_Single()
Dim oLookApp As Object
Dim oLookItm As Object
Dim oLookIns As Object
Dim oWrdDoc As Object
Dim oWrdRng As Object
Dim ExcRng As Range
On Error Resume Next
Set oLookApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Err.Clear
Set oLookApp = Object
End If
Set oLookItm = oLookApp.CreateItem(olMailItem)
Set ExcRng = ActiveWorkbook.Sheets("Sheet1").Range("B4:L26")
With oLookItm
//Email
.To = ActiveWorkbook.Sheets("Sheet1").Range("X1")
.CC = ActiveWorkbook.Sheets("Sheet1").Range("V1")
.Subject = "Here are all of my Ranges"
.Body = "Here are all the Ranges from my worksheet."
'Display the email
.Display
'Get the Active Inspector
Set oLookIns = .GetInspector
'Get the document within the inspector
Set oWrdDoc = oLookIns.WordEditor
ExcRng.Copy
Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
oWrdRng.Collapse Direction:=wdCollapseEnd
Set oWrdRng = oWdEditor.Paragraphs.Add
oWrdRng.InsertBreak
oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture
End With
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 trying to use VBA to paste a selected range from Excel to Outlook. I want to keep it under the same conversation with all the recipients.
I have seen some codes: Outlook Reply or ReplyAll to an Email
I am stuck with this code (Application.ActiveExplorer.Selection).
Any ideas how to do this?
This is the code I have when creating a new email instead of replying:
Sub a()
Dim r As Range
Set r = Range("B1:AC42")
r.Copy
'Paste as picture in sheet and cut immediately
Dim p As Picture
Set p = ActiveSheet.Pictures.Paste
p.Cut
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
'Get its Word editor
outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
With outMail
.BodyFormat = olFormatHTML
.Display
'.HTMLBody = "write your email here" & "<br>" & .HTMLBody
.Subject = ""
.Attachments.Add ("path")
End With
'Paste picture
wordDoc.Range.Paste
For Each shp In wordDoc.InlineShapes
shp.ScaleHeight = 50 shp.ScaleWidth = 50
Next
End Sub
EDIT:
I noticed that your question was edited by another user and now the mention of your need for the email to be a reply-all email is gone. This was probably in order to make your question simpler, but now my answer won't make as much sense. My answer also assumes that you also already have the HTML code needed to insert the email. If that's not the case, you might want to have a look at this gist to get you started on converting a range to HTML code.
The question you are linking to was on Outlook VBA so you have to make sure that you declare your variables differently since in Excel VBA, Application will refer to the Excel application and not Outlook.
Here's how you could go about this:
Sub ReplyAllWithTable()
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' ReplyAll
Dim HtmlTable As String
HtmlTable = "<table><tr><td>Test</td><td>123</td></tr><tr><td>123</td><td>test</td></tr></table>"
For Each olItem In outlookApp.ActiveExplorer.Selection
Set olReply = olItem.ReplyAll
olReply.HTMLBody = "Here is the table: " & vbCrLf & HtmlTable & vbCrLf & olReply.HTMLBody
olReply.Display
'Uncomment next line when you're done with debugging
'olReply.Send
Next olItem
End Sub
About pasting range as a picture
If you take the approach in the code above, you won't be able to use the copy-paste method to insert your image. I personally prefer to set the HTML body of the email instead since it gives you more control. If you are ok with using the HTML method you could either:
convert your range to HTML code and insert it inside the email (similarly as how it was done in the code above); or
convert your range to an image, save it and insert it with HTML in the email body.
In order to achieve the 2nd option, you could run the following code:
Sub ReplyAllWithTableAsPicture()
'REFERENCE:
'- https://excel-macro.tutorialhorizon.com/excel-vba-send-mail-with-embedded-image-in-message-body-from-ms-outlook-using-excel/
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' ReplyAll
Dim fileName As String
Dim fileFullName As String
fileFullName = Environ("temp") & "\Temp.jpg" 'CUSTOMIZABLE (make sure this file can be overwritten at will)
fileName = Split(fileFullName, "\")(UBound(Split(fileFullName, "\")))
RangeToImage fileFullName:=fileFullName, rng:=ActiveSheet.Range("B1:AC42") 'CUSTOMIZABLE (choose the range to save as picture)
For Each olItem In outlookApp.ActiveExplorer.Selection 'if we have only one email, we could use: set olItem = outlookApp.ActiveExplorer.Selection(1)
Set olReply = olItem.ReplyAll
olReply.Attachments.Add fileFullName, olByValue, 0
olReply.HTMLBody = "Here is the table: " & "<br>" & "<img src='cid:" & fileName & "'>" & vbCrLf & olReply.HTMLBody
olReply.Display
'Uncomment this line when you're done with debugging
'olReply.Send
Next olItem
End Sub
And add the following sub procedure in the module as well:
Sub RangeToImage(ByVal fileFullName As String, ByRef rng As Range)
'REFERENCE:
'- https://analystcave.com/excel-image-vba-save-range-workbook-image/
Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
Dim pic As Variant
'Create temporary chart as canvas
Set sht = rng.Worksheet
rng.Copy
sht.Pictures.Paste.Select
Set sh = sht.Shapes(sht.Shapes.Count)
Set tmpChart = Charts.Add
tmpChart.ChartArea.Clear
tmpChart.Name = "PicChart" & (Rnd() * 10000)
Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
tmpChart.ChartArea.Width = sh.Width
tmpChart.ChartArea.Height = sh.Height
tmpChart.Parent.Border.LineStyle = 0
'Paste range as image to chart
sh.Copy
tmpChart.ChartArea.Select
tmpChart.Paste
'Save chart image to file
tmpChart.Export fileName:=fileFullName, FilterName:="jpg"
'Clean up
sht.Cells(1, 1).Activate
sht.ChartObjects(sht.ChartObjects.Count).Delete
sh.Delete
End Sub
Explanations:
In the ReplyAllWithTableAsPicture procedure, we are essentially doing the same thing as the first code, but we are now attaching an image to the email but keep it "hidden" so we can just include it in the body of the email without it being in the list of attachements when people receive the email. To include the image, we use the img tag with a source starting with "cid" allowing us to refer to the "hidden" attachment.
Since the image has to be a file, we use the RangeToImage procedure to generate the image file from the range that we supply. Currently, the file will be saved in the temporary directory always with the same name, which means that the file would be overwritten. Feel free to change the name or add the date to the name if you which to keep copies of these image files.
Instead of creating mail item, Work with Selection item
Example outlookApp.ActiveExplorer.Selection(1)
Your code
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
'Get its Word editor
outMail.Display
Change to
Dim sel_Item As Outlook.MailItem
Set sel_Item = outlookApp.ActiveExplorer.Selection(1)
Dim outMail As Outlook.MailItem
'Get its Word editor
Set outMail = sel_Item.ReplyAll