Send Mail From Excel Via Outlook With Attachment And Range As Mail Body

**Excel Fox** · 12-23-2013, 10:09 PM

You can do it like this, but you'll have to add some code to define the variable 'rng'

Code:

Sub Attachment()
Set Sourcewb = ActiveWorkbook
sFname = "Non IT Outstanding Claim Contra Report as on " & FormatDateTime(Date, vbLongDate) & ".xlsx"

With Sourcewb
    If bWorksheetExists("Debit") Then BuildString = "Debit" & ","
    If bWorksheetExists("Credit") Then BuildString = BuildString & "Credit" & ","
    If bWorksheetExists("Total") Then BuildString = BuildString & "Total" & ","
    If bWorksheetExists("Sheet3") Then BuildString = BuildString & "sheet3" & ","
    If Len(BuildString) > 0 Then    'there are sheets to use
        BuildString = Left(BuildString, Len(BuildString) - 1) 'remove last comma
        .Sheets(Split(BuildString, ",")).Copy
        
         On Error Resume Next
                
            'End With
        
        ActiveWorkbook.SaveAs (sPath & sFname)
        Application.DisplayAlerts = False
        With ActiveWorkbook
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
        .To = "kannan.ganapathy@redington.co.in"
        .CC = ""
        .BCC = ""
        .Subject = "Report as on " & FormatDateTime(Date, vbLongDate) & "-" & FormatDateTime(Time, vbLongTime)
        .Body = "Hi ," & vbCrLf & _
                 vbCrLf & _
                vbCrLf & _
                "Pls find the Attached  report as on" & " " & FormatDateTime(Date, vbLongDate) & "." & vbCrLf & _
                vbCrLf & _
                "============================================================================================================================================"
                 
        .HTMLBody = .Body & vbCrLf & RangetoHTML(rng)
        .Attachments.Add ActiveWorkbook.FullName
        .Importance = 2
        .SentOnBehalfOfName = """Reports Business Finance"" <prabhu.k@redington.co.in>"
        
            .display
                '.send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
        ActiveWorkbook.Close True
        End With
        Kill sPath & sFname
    Else
        MsgBox "No files to copy"
    End If
    
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Base" And ws.Name <> "Data" And ws.Name <> "Pivot Table" Then ws.Delete
Next
Application.DisplayAlerts = True
    
    
End With
End Sub