-
Aug 24th, 2020, 11:16 PM
#1
Thread Starter
Registered User
Email Sheet Range With Images/Formatting as Email Body
Hey guys, I hope you are all going well!
I am trying to email a sheet range as the emails body, the existing code works almost perfectly however, hyperlinks, images and certain text formatting like: Italics, are not being copied onto the temp workbook and then ultimately the email body. Would anyone be able to provide any assistance?
* Author of source code: Ron de Bruin from Excel Automation. All credit goes to Ron for his fantastic code.
Many thanks in advance!! P.S. I'm Completely new to VBA
Office 365,VBA Version: 7.1 Excel Version: 2007, Build: 13209, Year: Current (2020)
Code:
Function RangetoHTML(rng As Range)
'Auther Ron de Bruin From Excel Automation
Dim email1 As Worksheet
Set email1 = ActiveWorkbook.Worksheets("email")
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=-4104
.Cells(1).PasteSpecial Paste:=13
.Cells(1).PasteSpecial Paste:=-4122
.Cells(1).PasteSpecial Paste:=12
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Sub Mail_Range()
Dim email1 As Worksheet
Set email1 = ActiveWorkbook.Worksheets("email")
Dim rng As Range
Set rng = Nothing
Set rng = email1.Range("B1:L37")
Set rng = Sheets("email").Range("B1:L37").SpecialCells(xlCellTypeVisible)
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
With OutMail
.To = "Test"
.CC = ""
.BCC = ""
.Subject = "Test"
.HTMLBody = RangetoHTML(rng)
.display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
-
Aug 25th, 2020, 10:41 AM
#2
Re: Email Sheet Range With Images/Formatting as Email Body
Hello K@g}{, welcome to the forum!
While I don't have an answer to your specific problem I noticed two things:
1. "On Error Resume Next" immediately followed by "On Error GoTo 0" - since the latter disables the former I would remove the "On Error Resume Next" part.
2. Don't use magic numbers in your code if it's all possible, or in this case the values used in the ".Cells(1).PasteSpecial Paste" lines. The proper names for these values can be found in the "XlPasteSpecialOperation" enumeration and should be combined as required by using the Or bitwise operator.
yours,
Peter Swinkels
Last edited by Peter Swinkels; Aug 26th, 2020 at 05:51 AM.
Reason: typo
-
Aug 26th, 2020, 05:21 AM
#3
Re: Email Sheet Range With Images/Formatting as Email Body
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=-4104
.Cells(1).PasteSpecial Paste:=13
.Cells(1).PasteSpecial Paste:=-4122
.Cells(1).PasteSpecial Paste:=12
.Cells(1).Select
each of these paste operations overwrite the previous one, as posted above, you probably need to combine the paste operations
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Aug 26th, 2020, 10:56 AM
#4
Re: Email Sheet Range With Images/Formatting as Email Body
Code:
Dim rng As Range
Set rng = Nothing
Set rng = email1.Range("B1:L37")
Set rng = Sheets("email").Range("B1:L37").SpecialCells(xlCellTypeVisible)
These lines are also redundant ... the first defines a variable, which by default will be nothing, so the second line doesn't add any value. You then set it to a range, followed immediately by setting it to the visible cells in that range... overwriting what you had there originally... so what's the point?
Code:
Dim rng As Range
Set rng = Sheets("email").Range("B1:L37").SpecialCells(xlCellTypeVisible)
Should be sufficient.
Now for the crux of the problem...
Code:
With OutMail
.To = "Test"
.CC = ""
.BCC = ""
.Subject = "Test"
.HTMLBody = RangetoHTML(rng)
.display
End With
First kudos for using HTMLBody ... usually when I see posts like this it's because they used .Body and not .HTMLBody... so nice job there....
So... what does RangetoHTML do? I mean, I know what it does based on the name... but what does that funciton look like? Is it producing the correct result? If I had to guess, I'd suspect not, and so tht's the first thing I'd look at.
Second... how do you know it's not working? Are you going based on the display? Or on the sent result? I'd look at sending the email and reviewing what comes out the other end. I wouldn't be surprised if it comes out correctly. I think when you create an outlook mail object like that, by default it is a text email.... not an HTML based one... look in the properties of the object for OutMail, and see if there is a Type or something that you can flip from "text style" to "HTML Style"/
-tg
-
Aug 27th, 2020, 06:15 AM
#5
Re: Email Sheet Range With Images/Formatting as Email Body
So... what does RangetoHTML do?
the function is in the post, publishes a temp workbook as html, returns the html string from the saved file
however, hyperlinks, images and certain text formatting like: Italics, are not being copied onto the temp workbook
looks like the problem is not to do with the outlook object
you could test
Code:
rng.copy TempWB.Sheets(1).Cells(1)
in place of all the existing codes pastespecial lines in the with block, and there is no need to select the .cells(1) at all
if that does not resolve the issue you can try combining the different pastespecial values to a single pastespecial as currently each overwrites the previous, though i would think that xlpasteall should do all you require, which is the default anyway
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Sep 8th, 2020, 08:41 PM
#6
Thread Starter
Registered User
Re: Email Sheet Range With Images/Formatting as Email Body
Hey guys,
Thanks for all your replies also super sorry for the super delayed response!!
@Peter Swinkels I’ve since taken that one out, thanks for pointing it one out. I’m also not too sure how the best way would be in combining “XLPaste using bitwise operators.” (I’ve had a google for some tutorials but hadn’t really found anything that I could understand. (I’ve not a very broad knowledge of coding in general. I’ve just started grade 8 😊 )
@ techgnome Hey thanks for the message! Ahh yes, I see now, I had missed that one! Also I didn’t know that the default would be nothing, all always learning every day! 😊
Re: HTMLBody, Thanks for the kudos, all credit goes to Ron de Bruin 😊
I have since been testing both methods, displayed and sent.
I’ve been thinking about everyone’s posts and suggestions and have changed a few things and has done some playing around in order to help find the issue. The results with the changes made are as follows:
Copping everything over from the original workbook to the “temp workbook (TempWB)”: all; values, formats, hyperlinks and even column widths, work/copy perfectly, all except the images. (Whereas before only the values had copied) So I don’t think the issue would be there, would it?
I think I have managed to narrow down where the issue lies. When copying everything from the “temp workbook (TempWB)” it seems that only the; column widths are not being preserved/copied and of course also the images, but they never copied to the “temp workbook (TempWB)” anyway.
I've also updated the code in the OP to reflect some of the change.
As always thanks again for all your posts and stay safe!
-
Sep 8th, 2020, 08:54 PM
#7
Thread Starter
Registered User
Re: Email Sheet Range With Images/Formatting as Email Body
Opps sorry, please ignore *"I've updated the code in the OP" message in my first reply. I have just figured out that I can't do that ahah. I'll place the updated code in this mesage.
Code:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim P_M As Worksheet
Set P_M = ActiveWorkbook.Worksheets("P M")
Dim WORK_PM As Worksheet
Set WORK_PM = ActiveWorkbook.Worksheets("WORK_PM")
Dim Email As Worksheet
Set Email = ActiveWorkbook.Worksheets("Email")
Dim Password As String
Password = Split(P_M.Range("N11").Value, " ")(0)
Dim Y As Double
Y = DateValue(Now)
P_M.Unprotect Password
Email.Unprotect Password
WORK_PM.Unprotect Password
Dim strpath As String
strpath = Environ$("temp") & "\"
Dim strFName2 As String
strFName2 = (WORK_PM.Range("J20").Value) & Y & ".pdf"
Set rng = Sheets("Email").Range("B1:L39").SpecialCells(xlCellTypeVisible)
Dim numberSET1 As String
numberSET1 = WORK_PM.Range("j20").Value
Dim NUMBER_PM_5 As String
NUMBER_PM_5 = WORK_PM.Range("I25").Value
Dim month3 As String
month3 = WORK_PM.Range("I25").Value
WORK_PM.Range("I25").Value = month3
month3 = Format(Date, "mmm yyyy")
WORK_PM.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strpath & strFName2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "test@gmail.com"
.CC = ""
.BCC = ""
.Subject = "(" & WORK_PM & ")" & month3 & "{" & Y & "}"
.HTMLBody = RangetoHTML(rng)
.Attachments.Add strpath & strFName2
.send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Kill strpath & strFName2
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
With TempWB.PublishObjects.Add(SourceType:=xlSourceRange, Filename:=TempFile, Sheet:=TempWB.Sheets(1).Name, Source:=TempWB.Sheets(1).UsedRange.Address, HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
-
Sep 10th, 2020, 07:24 AM
#8
Re: Email Sheet Range With Images/Formatting as Email Body
you could try writing your own html table, that way you can set the widths of columns etc as well as the text, font properties etc, i have done this before in a more limited way
as the images are probably not contained within cells, but just locked to them for display positioning, they will not be copied with the range,
if the images are on the web, you can then display them in your table, with the html code for an image hyperlink, the hyperlinks could be stored in cells
while the html string generated by code will be quite a long, it will probably be less the the html string from the published workbook
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|