Macro to email Range from Excel Sheet

[howard]

I have the following code below to email a range which I obtain from Ron de Bruin's Website

i have made a few small changes

I would be appreciateed if someone can mend it to display so the email can be checked before clicking on Send button on outlook

 Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
'Working in Excel 2002-2016
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range

    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("Sheet1").Range("B1:B15")

    'Remember the activesheet
    Set AWorksheet = ActiveSheet

    With Sendrng

        ' Select the worksheet with the range you want to send
        .Parent.Select

        'Remember the ActiveCell on that worksheet
        Set rng = ActiveCell

        'Select the range you want to mail
        .Select

        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            .Introduction = "This is test mail 2."

            With .Item
                .To = Sheets(1).Range("A1")
                .CC = ""
                .BCC = ""
                .Subject = Sheets(1).Range("B1")
                .Send
            End With

        End With

        'select the original ActiveCell
        rng.Select
    End With

    'Activate the sheet that was active before you run the macro
    AWorksheet.Select

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

 

[Logit]

Change the following :

With .Item
                .To = Sheets(1).Range("A1")
                .CC = ""
                .BCC = ""
                .Subject = Sheets(1).Range("B1")
               
                'change the following from .Send to .Display
                'then either delete or comment out .Send
                
                 .Send
               
            End With

 

[howard]

Thanks for the reply

I amend code to from .send to .Display but email not being displayed

Not sure why it is not being displayed , unless some of the other code needs to be amended as well

With .Item
.To = Sheets(1).Range("A1")
.CC = ""
.BCC = ""
.Subject = Sheets(1).Range("B1")

'change the following from .Send to .Display
'then either delete or comment out .Send

.Display [/code]

Kindly check & advise

 

[Logit]

Option Explicit


Sub Send_Mail_From_Excel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim Sendrng As Range
    
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("Sheet1").Range("B1:B15")

    'Send Mass Email Using Excel VBA Macro Code
    With OutlookMail
        .To = Sheets(1).Range("A1").Value
        .CC = ""
        .BCC = ""
        .Subject = Sheets(1).Range("B1").Value
        '.Send
        .Display
    End With
 
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[howard]

Thanks Logit

Email is generated but the body is not being displayed in Outlook

See range below for Body in B3

Email Template with Range.xlsm
	B
3	HI Please attend to the following items below : Follow-up on Debtors over 60 days Follow-up on Gross profit margins, which are too low Regards Howard
Sheet1

 

[Logit]

Option Explicit

Sub Send_Mail_From_Excel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim Sendrng As Range
    
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("Sheet1").Range("B1:B15")

    'Send Mass Email Using Excel VBA Macro Code
    With OutlookMail
        .To = Sheets(1).Range("A1").Value
        .CC = ""
        .BCC = ""
        .Subject = Sheets(1).Range("B1").Value
        .Body = Sheets(1).Range("B3").Value
        '.Send
        .Display
    End With
 
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[howard]

Many Thanksfor the help Logit

I can now see where there problem was

I did not have the code below which is required to generate text in the body of the email. Don't know how I overlooked this

 .Body = Sheets(1).Range("B3").Value

 

[Logit]

Glad you have an answer.