I'm using an Excel file to create an Outlook email with all our contacts in a list within the Excel file.
There's a single image (objshape) within Worksheet1, all by itself.
The image is pasted at Range (0, 0) which ends up at the beginning of my email.
I want it at the bottom, after the main HTML body.
VBA coding I have so far:
Sub CopyImagesToMail()
Dim objWorksheet As Excel.Worksheet
Dim objOutlookApp As Object
Dim objMail As Object
Dim objMailDocument As Object
Dim objShape As Excel.Shape
Set objWorksheet = ThisWorkbook.Worksheets(1)
Set objOutlookApp = CreateObject("Outlook.application")
Set objMail = objOutlookApp.CreateItem(objOutlookAppobjMailItem)
Set objMailDocument = objMail.GetInspector.WordEditor
For Each objShape In objWorksheet.Shapes
objShape.Copy
Next
With objMail
.To = ""
.CC = ""
.BCC = Sheets("Principal").Range("DistributionList")
.Subject = "Enter subject here"
.HTMLBody = "<html>" & _
"<br/>" & _
"<p style=""text-align:left"">Enter greetings here</p>" & _
"<p style=""text-align:left"">Enter text here </p>" & _
"<p style=""text-align:left"">Enter text here </p>" & _
"<p style=""text-align:left"">Enter text here </p>" & _
"<p style=""text-align:left"">Enter text here </b>" & _
"<br/>" & _
"<br/>" & _
"<p style=""text-align:left"">Thank you</p>" & _
"<br/>" & _
"<p style=""text-align:left"">Announce Website here (CTRL + Click) </p>" & _
"<p style=""text-align:left""> Hypertext description here</p>" & _
"</html>"
objMailDocument.Range(0, 0).Paste
End With
objMail.Display
End Sub
First of all, I'd suggest using the one or another way of setting the message body. If you decide to go with the HTMLBody property then construct your string based on the Excel data. If you want to deal with Word you can use its object model. Try to use the following code to paste the content to the end of documents:
objMailDocument.Content.Select ' selects the main text story
objMailDocument.Selection.Collapse wdCollapseEnd
objMailDocument.Selection.Paste
Related
I set up a worksheet with a button/macro that will produce an Outlook email template.
I am trying to lift the content for the email (which changes daily) from a specific cell to paste the email whilst retaining the spacing and line format that is in the Excel cell.
The code achieves this, except for when the email content is more than one line.
For example if I put the following in the target cell:
Test
Test
Test
The email will show the content as:
TestTestTest
Sub TestEmail()
Dim OApp As Object, OMail As Object, signature As String
Dim cFill As String
Dim cEmail As String
Dim sheet As Worksheet
Set OApp = CreateObject("Outlook.Application")
Dim Content As String
Content = Worksheets("Misc").Range("K13").Value2
Content = Format(Content, "Fixed")
MyDate = Format(Date, "dd mmm yyyy")
''1
Set OMail = OApp.CreateItem(0)
CurrentUser = Application.UserName
With OMail
.Display
End With
signature = OMail.HTMLBody
With OMail
myContent = "Good Morning," & _
"<br>" & _
"<br>" & _
"Please see the attached." & _
"<br>" & _
"<br>" & _
Content & _
"<br>" & _
"<br>" & _
"Kind Regards," & "<br>" & "<br>" & CurrentUser
.To = "test#test.com"
.CC = "test#test.com"
.Subject = "Test Email" & " " & MyDate
.Attachments.Add pdfPath & LatestFile
.HTMLBody = myContent & vbNewLine & vbNewLine & signature
.Display
End With
End Sub
I tried various suggestions from other questions. Those tend to be Word->Word, Word->Outlook. I haven't found one that works for this specific issue.
The code has this line:
Content = Format(Content, "Fixed")
which appeared to work for a slightly different case than this.
I also tried:
Range("K13").Value
Range("K13").Text
As well as XlPasteFormats after copying, but this returned an error.
For pasting the linebreaks you could use this function. It takes the Text, splits it at the linebreaks, then it loops through each line and adds an "" to it.
Function linebreaker(Text as String)
textlines = Split(Text, Chr(10))
Text = ""
For Each Line In textlines
Text = Text & "<br>" & Line
Next
Debug.Print Text
linebreaker = Text
End Sub
Its only from my head so i didnt test it.
Add this line after you get Value2 from the cell:
Content = Replace(Content, vbLf, "<br>")
Basically it converts vbLf to HTML tag <br> which should be acceptable in the mail body.
Separately, you should declare all variables at all times, please insert Option Explicit at the top of your module to help you identify which variable are not declared.
In Outlook, you have the option to tag a recipient using #'required emailid' in the mail body. Email will be highlighted for all tagged recipients.
I have 2 columns in Excel.
A
B
#user1, #user2
sit
#user3, #user1
stand
I want these values to be read from Excel and create a text string and put on mail body, like:
#User1, #User2. Please sit
#user3, #User1. Please stand.
where each userid is tagged/linked.
Below is the code that I have tried. It is pasting the '#User1' etc. as simple text and not as tags-
Sub send_mail_test()
Set wb = ActiveWorkbook
Set sh = ActiveSheet
un = Application.UserName
rr = Cells(1, 1).End(xlDown).row
Subj = "This is a test mail"
body = "<p>" & "Hi All," & "</p>" & _
"<p>" & "Below is the list of tasks - " & "</p>" & _
"<p>" & "Action Items - " & "<br />" & "<ol>"
For i = 2 To rr
If Cells(i, 1) <> "" Then
body = body & "<li>" & sh.Cells(i, 1).Value & ". Please - " & sh.Cells(i, 2) & "</li>"
End If
Next i
body = body & "</ol>" & "</p>" & _
"<p>" & "Thanks," & "<br />" & un & "</p>"
' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' CREATE EMAIL OBJECT.
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "ABC#XYZ.COM"
.Cc = "ABC#XYZ.COM"
.Subject = Subj
.HTMLbody = body
.Display ' DISPLAY MESSAGE.
End With
' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing
End Sub
I used the code below to copy a range from a file and paste it as a picture on emails, but there's a catch: if you don´t use .display before .send, the picture will not be displayed to the receiver.
Does anyone know a way around this? Just to avoid the outlook window flashing on the screen.
Sub sendMail()
Dim olApp As Object
Dim NewMail As Object
Dim ChartName As String
Dim imgPath As String
Set olApp = CreateObject("Outlook.Application")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"
Workbooks.Open "C:\FilePath\File.xlsm"
Set RangeToSend = Workbooks("File.xlsm").Sheets(Name).Range(" ")
RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set sht = Sheets.Add
sht.Shapes.AddChart
sht.Shapes.Item(1).Select
Set objChart = ActiveChart
With objChart
.ChartArea.Height = RangeToSend.Height
.ChartArea.Width = RangeToSend.Width
.ChartArea.Fill.Visible = msoFalse
.ChartArea.Border.LineStyle = xlLineStyleNone
.Paste
.Export Filename:=tmpImageName, FilterName:="JPG"
End With
sht.Delete
Workbooks("File.xlsm").Close
Set NewMail = olApp.CreateItem(0)
With NewMail
.Subject = "Latest performance report" ' Replace this with your Subject
.To = "email#email.com" ' Replace it with your actual email
.HTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Hello, this is the data range that you want:<br> " _
& "<br>" _
& "<img src=" & "'" & tmpImageName & "'/>" _
& "<br>" _
& "<img src=" & "'" & tmpImageName2 & "'/>" _
& "<br>" _
& "<br>Best Regards!</font></span>"
.Display
.Send
Set olApp = Nothing
Set NewMail = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End With
End Sub
Looks like you are saving the picture captured in Excel to a disk. And then you are referring to the image in a newly created item body. But the image source still points to the file on your disk. So, the recipient will never get it shown correctly.
Instead, you need to attach a file and then add a reference in the message body.
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
...
Set colAttach = mail.Attachments
Set l_Attach = colAttach.Add(path_to_the_file)
Set oPA = l_Attach.PropertyAccessor
oPA.SetProperty PR_ATTACH_CONTENT_ID, "itemID"
oPA.SetProperty PR_ATTACHMENT_HIDDEN, True
Then you can modify the message body in the following way:
.HTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Hello, this is the data range that you want:<br> " _
& "<br>" _
& "<img src='cid:itemID'/>" _
& "<br>" _
& "<br>Best Regards!</font></span>"
.Send
I am trying to generate several Mails with a text body and a scaled background image. Everything works out, the only problem is, that the background image appears many times instead of one time with the correct scale.
Setting a background image using HTML in an outlook email using Excel VBA
I've tried this approach, but the
MyHTML = "<body background=""cid:Pic1.jpg""; center top no-repeat;>"
code does not work for me.
Sub FORMATIERUNG_TESTEN()
Dim objOLOutlook As Object
Dim objOLMail As Object
Dim lngMailNr As Long
Dim lngZaehler As Long
Dim strAttachmentPfad1 As String
Dim a As String
Dim image As String
Dim strbody As String
Dim MyHTML As String
Dim MyText As String
On Error GoTo ErrorHandler
Set objOLOutlook = CreateObject("Outlook.Application")
lngMailNr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
strAttachmentPfad1 = "C:\Users\User\Downloads\Pic1.jpg"
'running through every not empty line of column a to get the email adresses
For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 1) <> "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
On Error Resume Next
With objOLMail
.To = Cells(lngZaehler, 1)
.CC = Cells(lngZaehler, 2)
.BCC = ""
.Sensitivity = 0
.Importance = 0
.Subject = "Test"
'creating the text body of the mail
strbody = "<font size=""2,9"" face=""Source Sans Pro"" color=""#2F5496"">" & _
"TEXT TEXT TEXT TEXT TEXT" & "</font>"
'here is the problem: I get the background image in the mail, but the "no repeat" command does not work
MyHTML = "<body background=""cid:Pic1.jpg""; center top no-repeat;>"
.HTMLBody = MyHTML & "<br>" & "<br>" & "<br>" & strbody & "<br>" & "<br>" & "<br>" & "<br>" & "<img src = 'Signature.jpg' >"
.Display
'.Send
.Attachments.Add strAttachmentPfad1
End With
Set objOLMail = Nothing
End If
Next lngZaehler
Set objOLOutlook = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " " & Err.Description & " " & Err.Source, _
vbInformation, "Error"
End Sub
I have use the below macro to copy graph into picture and text to outlook to send out. I have set the emails to myself and 2 other recipient.
I am manage to see those graph, however the other 2 recipient cannot see the graph. they see it as a cross (X) in a box. my temp files isn't deleted so I don't know why they see cross in the image of the graph
Sub SendChart_As_Body_UsingOutlook()
Dim rng As Range
Dim olApp As Object
Dim NewMail As Object
Dim ChartName As String
Dim ChartName1 As String
Set rng = Range("A1:AQ45").SpecialCells(xlCellTypeVisible)
Set olApp = CreateObject("Outlook.Application")
'fill in the file path/name of the gif file
ChartName = Environ$("temp") & "\Chart.gif"
ChartName1 = Environ$("temp") & "\Chart1.gif"
ActiveWorkbook.Worksheets("feb 18").ChartObjects("Chart 1").Chart.Export _
Filename:=ChartName, FilterName:="JPEG"
ActiveWorkbook.Worksheets("feb 18").ChartObjects("Chart 2").Chart.Export _
Filename:=ChartName1, FilterName:="JPEG"
' Create a new mail message item.
Set NewMail = olApp.CreateItem(0)
With NewMail
.Subject = "copy graph and text - Auto"
.To = "meme#xxx.com; reciep1#xxx.com; reciept2#xxx.com"
.HTMLBody = RangetoHTML(rng) & "<img src=" & "'" & ChartName1 & "'>" & "<img src=" & "'" & ChartName & "'>"
.send
End With
'Now delete the chart image from the temp folder
'Kill ChartName
'Release memory.
Set olApp = Nothing
Set NewMail = Nothing
End Sub
The problem is that you're just creating a link to the image on your PC, not embedding the image in the e-mail. You need to include an Attachments.Add line in your VBA. See embedded Images in html email from Excel VBA .
Try something like this
With NewMail
.Subject = "copy graph and text - Auto"
.To = "meme#xxx.com; reciep1#xxx.com; reciept2#xxx.com"
.Attachments.Add ChartName, olByValue, 0
.Attachments.Add ChartName1, olByValue, 0
.HTMLBody = "<body>" & RangetoHTML(Rng) & _
"<img src=" & "'" & ChartName1 & "'>" & _
"<img src=" & "'" & ChartName & "'> </body>"
.Display
End With
Here is another examples using Word object
https://stackoverflow.com/a/48897439/4539709
https://stackoverflow.com/a/40052843/4539709