Results 1 to 8 of 8

Thread: Email Sheet Range With Images/Formatting as Email Body

  1. #1

    Thread Starter
    Registered User
    Join Date
    Aug 2020
    Posts
    3

    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

  2. #2
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,807

    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

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    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

  4. #4
    Smooth Moperator techgnome's Avatar
    Join Date
    May 2002
    Posts
    34,531

    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
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    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

  6. #6

    Thread Starter
    Registered User
    Join Date
    Aug 2020
    Posts
    3

    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!

  7. #7

    Thread Starter
    Registered User
    Join Date
    Aug 2020
    Posts
    3

    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

  8. #8
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    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
  •  



Click Here to Expand Forum to Full Width