+ Reply to Thread
Results 1 to 6 of 6

RangetoHTML function changes formatting of everything after it

Hybrid View

  1. #1
    Registered User
    Join Date
    01-11-2017
    Location
    New York
    MS-Off Ver
    2010
    Posts
    7

    RangetoHTML function changes formatting of everything after it

    Hello all, I am on Excel 2010 VBA. I am using the Ron De Bruin RangetoHTML function to copy and paste sections of a spreadsheet to different email addresses, using an email template that I have created with placeholder text for where the RangetoHTML contents should go. I only needed the RangetoHTML for a certain section of the email body since the rest of the email will be the same for everyone else.

    Everything seems to work fine but instead of the replace function just replacing the placeholder text with the range that is copied from the spreadsheet, everything below the range in the email text is now formatted differently even though everything before the pasted range looks correct. Does anyone know how this could be fixed, if at all? The entire code I used is below.

    Option Explicit
    Sub Emails()
    Dim i As Long
    Dim OutlookApp As Object
    Dim OutlookItem As Object
    Const OutlookMailItem As Long = 0
    Dim intChoice As Integer
    Dim 1TemplatePathAnswer As Integer
    Dim 1TemplatePath As String
    Dim 2TemplatePathAnswer As Integer
    Dim 2TemplatePath As String
    Dim 2Contact As String
    Dim rng As Range
    
    1TemplatePathAnswer = MsgBox("Do you know the path for the #1 email template?", vbYesNoCancel + vbQuestion, _
               "Please Respond")
    If 1TemplatePathAnswer = vbYes Then
        'Get filepath for the RFI
        With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\Users\" & Environ$("Username") & "\AppData\Roaming\Microsoft\Templates"
        .AllowMultiSelect = False
        'make the file dialog visible to the user
        intChoice = Application.FileDialog(msoFileDialogOpen).Show
        'determine what choice the user made
        If intChoice <> 0 Then
        'get the file path selected by the user
          1TemplatePath = Application.FileDialog( _
                msoFileDialogOpen).SelectedItems(1)
            Else: End
        End If
        End With
    ElseIf 1TemplatePathAnswer = vbCancel Then
            Exit Sub
    ElseIf 1TemplatePathAnswer = vbNo Then
            MsgBox ("You will need to know the location of the email template to use this macro.")
            Exit Sub
    End If
    
    2TemplatePathAnswer = MsgBox("Do you know the path for the #2 email template?", vbYesNoCancel + vbQuestion, _
               "Please Respond")
    If 2TemplatePathAnswer = vbYes Then
        'Get filepath for the RFI
        With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\Users\" & Environ$("Username") & "\AppData\Roaming\Microsoft\Templates"
        .AllowMultiSelect = False
        'make the file dialog visible to the user
        intChoice = Application.FileDialog(msoFileDialogOpen).Show
        'determine what choice the user made
        If intChoice <> 0 Then
        'get the file path selected by the user
          2TemplatePath = Application.FileDialog( _
                msoFileDialogOpen).SelectedItems(1)
            Else: End
        End If
        End With
    ElseIf 2TemplatePathAnswer = vbCancel Then
            Exit Sub
    ElseIf 2TemplatePathAnswer = vbNo Then
            MsgBox ("You will need to know the location of the email template to use this macro.")
            Exit Sub
    End If
    
    'Step 1: Initialize an Outlook session.
    Set OutlookApp = CreateObject("Outlook.Application")
    'Step 2: For each non-empty cell in the range, create a new message.
    Range("A2").Select
    Do Until IsEmpty(ActiveCell)
    2Contact = ActiveCell.Offset(0, 7).Value
        Do Until ActiveCell.Offset(0, 7).Value <> 2Contact
        Set OutlookItem = OutlookApp.CreateItemFromTemplate(1TemplatePath)
        On Error Resume Next
        With OutlookItem
        'Step3: Add the To recipient(s) to message.
            .To = ActiveCell.Offset(0, 2).Value
            .HTMLBody = Replace(.HTMLBody, "%PLACEHOLDER1%", ActiveCell.Offset(0, 5).Value)
            .HTMLBody = Replace(.HTMLBody, "%PLACEHOLDER2%", ActiveCell.Offset(0, 6).Value)
            .HTMLBody = Replace(.HTMLBody, "%PLACEHOLDER3%", ActiveCell.Offset(0, 7).Value)
            .Importance = olImportanceHigh 'High importance
            .Display
        End With
        On Error GoTo 0
        i = i + 1
        ActiveCell.Offset(1, 0).Select
        Loop
    Set rng = Range(ActiveCell.Offset(-i, 0), ActiveCell.Offset(0, 2))
    Set OutlookItem = OutlookApp.CreateItemFromTemplate(2TemplatePath)
    With OutlookItem
    'Step3: Add the To recipient(s) to message.
        .To = 2Contact
        .HTMLBody = Replace(.HTMLBody, "RANGETOHTML PLACEHOLDER", RangetoHTML(rng))
        .HTMLBody = Replace(.HTMLBody, "PLACEHOLDER1", ActiveCell.Offset(0, 5))
        .Importance = olImportanceHigh 'High importance
        .Display
        End With
    i = 0
    2Contact = ActiveCell.Offset(0, 7).Value
    Loop
    Set OutlookApp = Nothing
    Set OutlookItem = Nothing
    End Sub
    
    Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2016
        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"
    
        'Copy the range and create a new workbook to past the data in
        Set TempWB = Workbooks.Add(1)
        rng.Copy
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            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=")
    
        'Close TempWB
        TempWB.Close savechanges:=False
    
        'Delete the htm file we used in this function
        Kill TempFile
    
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
        
    End Function

  2. #2
    Forum Expert
    Join Date
    02-11-2014
    Location
    New York
    MS-Off Ver
    Excel 365 (Windows)
    Posts
    6,351

    Re: RangetoHTML function changes formatting of everything after it

    What happens if you do the insertion of the HTML range last? Switching the order of these two line to this:

        .HTMLBody = Replace(.HTMLBody, "PLACEHOLDER1", ActiveCell.Offset(0, 5))
        .HTMLBody = Replace(.HTMLBody, "RANGETOHTML PLACEHOLDER", RangetoHTML(rng))
    Bernie Deitrick
    Excel MVP 2000-2010

  3. #3
    Registered User
    Join Date
    01-11-2017
    Location
    New York
    MS-Off Ver
    2010
    Posts
    7

    Re: RangetoHTML function changes formatting of everything after it

    Quote Originally Posted by Bernie Deitrick View Post
    What happens if you do the insertion of the HTML range last? Switching the order of these two line to this:

        .HTMLBody = Replace(.HTMLBody, "PLACEHOLDER1", ActiveCell.Offset(0, 5))
        .HTMLBody = Replace(.HTMLBody, "RANGETOHTML PLACEHOLDER", RangetoHTML(rng))
    It does appear to make the same mistake. Also, I think I should have mentioned that the code seems to keep the color and size of the text, but changes the font to Times New Roman which is not what it should be. And also I said everything after the RangetoHTML changed font but I meant everything after it but before the signature (which does still have the correct formatting for some reason).

  4. #4
    Forum Guru Norie's Avatar
    Join Date
    02-02-2005
    Location
    Stirling, Scotland
    MS-Off Ver
    Microsoft Office 365
    Posts
    19,646

    Re: RangetoHTML function changes formatting of everything after it

    How do you want the body of the email after the HTML section to be formatted?

    Does it make any difference if you add opening and closing HTML body tags either side of RangetoHTML(rng) here?
     .HTMLBody = Replace(.HTMLBody, "RANGETOHTML PLACEHOLDER", RangetoHTML(rng))
    Note, I tried posting the tags I mentioned but apparently I broke some sort of security protocol or something in trying to do so.

    Anyway, here is a link.
    If posting code please use code tags, see here.

  5. #5
    Registered User
    Join Date
    01-11-2017
    Location
    New York
    MS-Off Ver
    2010
    Posts
    7

    Re: RangetoHTML function changes formatting of everything after it

    Quote Originally Posted by Norie View Post
    How do you want the body of the email after the HTML section to be formatted?

    Does it make any difference if you add opening and closing HTML body tags either side of RangetoHTML(rng) here?
     .HTMLBody = Replace(.HTMLBody, "RANGETOHTML PLACEHOLDER", RangetoHTML(rng))
    Note, I tried posting the tags I mentioned but apparently I broke some sort of security protocol or something in trying to do so.

    Anyway, here is a link.
    The text after the RangetoHTML and before the signaturshould be Calibri font, size 11, and RGB 31,73,125. So you mean use the literal tags that have the letters html inside or some other combination of html tags (like body or something else)? By the way I am writing it out in words to avoid the same error you mentioned by including HTML tags.

  6. #6
    Forum Guru Norie's Avatar
    Join Date
    02-02-2005
    Location
    Stirling, Scotland
    MS-Off Ver
    Microsoft Office 365
    Posts
    19,646

    Re: RangetoHTML function changes formatting of everything after it

    If you want to apply specific formatting to a section of the email body when you are using HTMLBody you might want to look at using the HTML tags that requires.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Preserve Hyperlinks Using rangetohtml excel to outlook vba code
    By Pang_george in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 07-12-2017, 09:56 PM
  2. Format body in RangetoHTML
    By Rui Farinha in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 11-15-2016, 01:22 PM
  3. Return to orignail view after rangetohtml coding.
    By knevil in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 11-05-2013, 09:35 AM
  4. RangetoHTML
    By bigpappi23 in forum Excel Programming / VBA / Macros
    Replies: 10
    Last Post: 04-23-2013, 04:10 AM
  5. RangetoHTML issue, Excel 2003
    By bondcrash in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 06-15-2011, 04:51 AM
  6. Setting RANGE for RangeToHTML
    By kmkelley in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 05-16-2011, 11:08 AM
  7. Sending Worksheet in body of email: RangetoHTML
    By mojo249 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-21-2010, 11:23 AM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1