CODEWITHSUNDEEP
vbaexcelemail
Pradeep
Pradeep

Reputation: 23

To send the details in multiple sheets in a single mail using a macro in Excel

Whenever I run a macro, I need to send certain Range of cells in different sheets to a Particular mail ID.

Sub Send_Range()

    Sheet1.Range("A2:V28").Select  

   ActiveWorkbook.EnvelopeVisible = True


   With ActiveSheet.MailEnvelope
     ' .Introduction = "This is a sample worksheet."
      .Item.To = "[email protected]"
      .Item.Subject = "My subject"
      .Item.Send
   End With
End Sub

Using this code I am able to send all Values of Range (A2:V28) from Sheet 1 in a mail. But I also want to send Values of Range (B3:F28) from Sheet 2 along with the values in sheet 1 in a single mail. Please help me.

Upvotes: 1

Views: 1916

Answers (1)

VBA Pete
VBA Pete

Reputation: 2666

You could use a function written by Ron de Bruin that allows you to convert ranges into HTML:

Sub SendRange()
Dim mailApp As Object, mail As Object  
Dim rng As Range, rng1 As Range   

Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.createitem(0)

Set rng = Sheets("Sheet1").Range("A2:V28").SpecialCells(xlCellTypeVisible)
Set rng1 = Sheets("Sheet2").Range("B3:F23").SpecialCells(xlCellTypeVisible)

With mail
    .To = "[email protected]"
    .Subject = "My subject"
    .HTMLBody = RangetoHTML(rng) & "<br>" & RangetoHTML(rng1)
    .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

Upvotes: 1

Related Questions