vba to copy entire data to email

[reza_doang]

Hi -

I get VBA macro to copy data in worksheet to email body from rondebruin.
But the code only copy the data and table without charts. Is there any way to copy all the data including charts?

Sub Mail_Sheet_Outlook_Body()'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2013
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set rng = Nothing
    'Set rng = ActiveSheet.UsedRange
    'You can also use a sheet name
    Set rng = Sheets("Sheet1").UsedRange

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "reza@xxxxxxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        '.Send   'or use
        .Display
    End With
    On Error GoTo 0

Thanks

Reza

 

[Logit]

.

Option Explicit




Sub mailchart()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector, GetInspector, wEditor As Variant




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "yo momma@nowhere.com"
        .CC = "xyz@anc.com"
        .BCC = "abc@xyz.com"
        .Subject = "Test"
        .Body = "Dear" & " Macro " & vbCrLf
        .Display
        ActiveSheet.Range("B2:R21").Copy  '<----- set range to copy here.
        Set vInspector = OutMail.GetInspector
        Set wEditor = vInspector.WordEditor
    
        wEditor.Application.Selection.Start = Len(.Body)
        wEditor.Application.Selection.End = wEditor.Application.Selection.Start
    
        wEditor.Application.Selection.Paste
    
    .Display
    '.Send
    End With
End Sub

 

[reza_doang]

.

Option Explicit




Sub mailchart()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector, GetInspector, wEditor As Variant




Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "yo momma@nowhere.com"
        .CC = "xyz@anc.com"
        .BCC = "abc@xyz.com"
        .Subject = "Test"
        .Body = "Dear" & " Macro " & vbCrLf
        .Display
        ActiveSheet.Range("B2:R21").Copy  '<----- set range to copy here.
        Set vInspector = OutMail.GetInspector
        Set wEditor = vInspector.WordEditor
    
        wEditor.Application.Selection.Start = Len(.Body)
        wEditor.Application.Selection.End = wEditor.Application.Selection.Start
    
        wEditor.Application.Selection.Paste
    
    .Display
    '.Send
    End With
End Sub

thanks Logit, is working perfectly.

 

[Logit]

.
You are welcome.