Excel email help

[NewUser2]

Hi, I've put together the following by combining some help from people on here and code on other forms. It works great for getting charts, ranges, etc, to set up an Outlook email from excel using VBA. Only trouble I am having is changing formatting. Or specifically, putting new lines between the multiple pasted ranges/graphs. (and YES, I've tried: .Body = wEditor & vbNewLine & wEditor2 (and of course I added a wEditor2...paste in the right spot), but that doesnt work.

Here is the code, any suggestions are greatly appreciated.
Thanks!

Option Explicit


Sub CopyAndPasteToMailBody()
Dim mailApp, mail As Object
Dim olMailItem, wEditor As Variant
Dim vInspector As Variant
Dim vInspector2 As Variant
Dim wEditor2 As Variant
Dim rngTo As Range, rngCc As Range, rngSubject As Range

Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(olMailItem)

mail.display

With Sheets("Summary")
Set rngTo = .Range("R8")
Set rngCc = .Range("R9")
Set rngSubject = .Range("C63")
End With

With mail
.To = rngTo.Value
.CC = rngCc.Value
.Subject = rngSubject.Value
.Body = wEditor


Set vInspector = mail.getInspector
Set wEditor = vInspector.WordEditor


ActiveSheet.Range("V7:Z7").Copy
wEditor.Application.Selection.Paste

ActiveSheet.Range("V9:Z58").Copy
wEditor.Application.Selection.Paste

ActiveSheet.ChartObjects("testchart").Activate
ActiveChart.ChartArea.Copy
wEditor.Application.Selection.Paste
End With
End Sub

 

[Logit]

.
.
Here is the basic macro. You'll need to add your various cell references, etc.

[COLOR=#333333]Option Explicit[/COLOR]

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("G11:N26").Copy
    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
End With
End Sub

 

[NewUser2]

Yeah, I have seen that code before, (which is where a lot of mine is coming from), and putting in that 'start' and 'end' section doesn't really do the trick. As you can see from what I posted, Im not using anything in my body, subject, etc, that's in " ", its all referenced from the workbook. And my problem still stands... how to insert lines between my different sections..

only way i can get it, is to do the long and wrong thing, and just copy/paste in some blank cells from Excel, using them as my spaces..

Any other suggestions?

 

[Logit]

.
.
Perhaps the easiest thing is the following macros. It copies a specified range and pastes that into the Email Body.
You could set aside one sheet in the workbook for this purpose, then arrange the sheet with text / pictures / charts
as desired so it displays perfectly in the email body.

You can also utilize HTML (within the macro code itself - partly hard coding & cell references) but that involves a good
knowledge of HTML and effort. The following macro makes it so much easier by simply laying out the sheet with the
content then copying it.

Sub CopyRows()
'You specify what range to copy and paste as the Email Body here:
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
    ws1.Range("U47:J49").Copy
    Mail_Selection_Range_Outlook_Body
End Sub


Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim lEndRow
Dim Value As String
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = Sheets("Sheet1").Range("U47:J49")
If rng Is Nothing Then
    MsgBox "An unknown error has occurred. "
    Exit Sub
End If
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = "Your email address here in quotes"
    .CC = ""
    .BCC = ""
    .Subject = "Trigger Point for Cars On Hand"


    .HTMLBody = "Text above Excel cells" & "

" & _
                RangetoHTML(rng) & "

" & _
                "Text below Excel cells.
"
    
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function