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

**Prabhu** · 12-20-2013, 04:15 PM

Hi Friends,

I have attached a workbook with 2 macro program.

Macro 1.Attachment: this macro help me to attach more than one sheets as single work book to send to particular email id given in the program.

Macro 2.MailbodyandAttachment: this macro help me to attach given(single) sheet and past given( single) sheet in the mail body.

I need a small modification in the above mentioned macro 1 i.e attachment contain more then two work sheet like macro 1 and to past the selected sheet(single) in the body of the mail like Macro2.

This changes will help me to attach more than one sheet as single workbook in the outlook mail also it will past the given sheet in the body of the mail.

Kindly do the needful to get the modified macro program.

Regards,

Prabhu

**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