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

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

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

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?f=44&t=40455&p=313035#p313035
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312889#p312889
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312886#p312886
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312752#p312752
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312734#p312734
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312727#p312727
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312724#p312724
https://www.eileenslounge.com/viewtopic.php?f=44&t=40374&p=312535#p312535
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9xpn-GDkL3o
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg. 9zYoeePv8sZ9zYqog9KZ5B
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9zYlZPKdOpm
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA