VBA Excel to Outlook pasting to body issue

[ed.ayers315]

Here is my code. I put this together via other posts I found in this forum; nothing did exactly what I needed as written.

Everything works the way I intend; the problem is the range I copy will not paste into the body of email.

How can i get this to work?

Appreciate any help or advice!

Public Sub Copy_and_Paste_Cells_To_Email_Body_LB()

    Dim OutApp As Object 'Outlook.Application
    Dim wDocument As Object 'Word.Document
    Dim wSelection As Object 'Word.Selection
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String
    Dim ThisFile As String
    Dim oByValue
    
    ThisFile = "C:\Users\My\Desktop\Report.pdf"
    Application.ScreenUpdating = True




    'Create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    
    With oMail
        .To = "ed.ayers315@hotmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "UF Log Exception reporting"




Set wkb = ActiveWorkbook
            Set wks = wkb.ActiveSheet
    Set OutApp = CreateObject("Outlook.Application")
        
        
            Set wkb = ActiveWorkbook
            Set wks = wkb.ActiveSheet
        
                Range("Q4").Select
                Selection.End(xlDown).Select
                Range("A1:Q7").Select
                Range("Q6").Activate
                Application.CutCopyMode = False
                Selection.Copy
                Application.CutCopyMode = False
                Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        .display
        .send
       
    Application.CutCopyMode = False
    End With
End Sub

 

[Domenic]

To copy a range of cells...

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

To embed an image within the body of an email...

https://www.mrexcel.com/forum/excel...d-font-using-vba-post5020086.html#post5020086

Hope this helps!

 

[ed.ayers315]

Thanks but no. I can get the email to send with all the information except the range in the body that is wanted.

I even tried naming the range, coping the range as a PNG picture, coping the range as a JPG picture the using [.body = x1picture]

Dang!!

 

[Domenic]

If you want to include a range of cells in the body of an email, the first link should help. Did you try it? If so, can you post the exact code that you tried?

 

[ed.ayers315]

Thanks for the Help

Sub Mail_Selection_Range_Outlook_Body()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    CurrentCIPlog = Range("A1:Q34").Select
    
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    


ActiveSheet.Unprotect
    
    Set rng = ActiveSheet.Range("CurrentCIPlog")
'    ActiveSheet.Select.Range ("CurrentCIPlog")
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = ActiveSheet.Range("CurrentCIPlog")
    'You can also use a fixed range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0


    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If


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


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


    ActiveWindow.SmallScroll ToRight:=5
    ActiveSheet.Range("$AI$4:$AI$33").AutoFilter Field:=1, Criteria1:="1"
    
    On Error Resume Next
    With OutMail
        .To = "ed.ayers@hydrite.com"
        .CC = "ed.ayers315@hotmail.com"
        .BCC = ""
        .Subject = "UF CIP Exception Report for "
'        .HTMLBody = x1picture
        .Body = ActiveSheet.Range("CurrentCIPlog")
        .Display   'or use .Send
        .Send
    End With
    On Error GoTo 0


    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

 

[Domenic]

It looks like you want to copy a range of cells as a picture, and then paste it into the body of your email. If so, try...

    [COLOR=darkblue]With[/COLOR] OutMail
        .To = "ed.ayers@hydrite.com"
        .CC = "ed.ayers315@hotmail.com"
        .BCC = ""
        .Subject = "UF CIP Exception Report for "
        .Display
        .GetInspector.WordEditor.Application.Selection.Paste
       [COLOR=#008000] '.Send[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

To paste at the end of the email, try the following instead...

    [COLOR=darkblue]With[/COLOR] OutMail
        .To = "ed.ayers@hydrite.com"
        .CC = "ed.ayers315@hotmail.com"
        .BCC = ""
        .Subject = "UF CIP Exception Report for "
        .Display  
        [COLOR=darkblue]With[/COLOR] .GetInspector.WordEditor
            .Application.Selection.EndKey Unit:=6 [COLOR=green]'to go to the end of email body[/COLOR]
            .Application.Selection.TypeParagraph [COLOR=green]'new line[/COLOR]
            .Application.Selection.TypeParagraph [COLOR=#008000]'new line[/COLOR]
            .Application.Selection.Paste
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With
[/COLOR]        [COLOR=#008000]'Send[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]

Hope this helps!

 

[ed.ayers315]

Thank you Domenic; works perfectly!!!

Solved