limit to rangetohtml(rng)?

[daveyc18]

   .htmlbody = strbody1 & " " & RangetoHTML(rng) & "<br><br>" & RangetoHTML(rng2) & "<br><br>" & RangetoHTML(rng3) & "<br><br>" & RangetoHTML(rng4) & "<br><br>" & RangetoHTML(rng5) & vbNewLine & Signature
     

   Set rng = Sheets(" Summary").Range("email_summary")
       
       Set rng2 = Sheets("FIN.PROD").Range("email_summary_2")
      
             Set rng3 = Sheets("Average Price").Range("email_summary_3")
      
              Set rng4 = Sheets("Top 10").Range("email_summary_4")
      
            Set rng5 = Sheets("Concentration Test").Range("email_summary_5")

seems like I can only do up to two..

 

[DanteAmor]

Works for me:

​

Try:

Sub Filter_and_Mail()
  Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range
  Dim strbody1 As String, Signature As String
  
  Set rng1 = Sheets("Summary").Range("email_summary")
  Set rng2 = Sheets("FIN.PROD").Range("email_summary_2")
  Set rng3 = Sheets("Average Price").Range("email_summary_3")
  Set rng4 = Sheets("Top 10").Range("email_summary_4")
  Set rng5 = Sheets("Concentration Test").Range("email_summary_5")
  
  strbody1 = "Hello"
  Signature = "Bye"
  With CreateObject("Outlook.Application").CreateItem(0)
    .To = "danteamor@correo.com"
    .Subject = "range html"
    .HTMLbody = strbody1 & " " & RangetoHTML(rng1) & "<br>" & RangetoHTML(rng2) & "<br>" & _
                                 RangetoHTML(rng3) & "<br>" & RangetoHTML(rng4) & "<br>" & _
                                 RangetoHTML(rng5) & vbNewLine & Signature
    .Display
  End With
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
  rng.Copy
  Set TempWB = Workbooks.Add(1)
  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