VBA copy visible cells to email body below text


New Member
Hi All,

Have the below code, almost there, but body text is currently going below the copied table and also want to add a signature.

Code- to copy visible cells in range into email body.

Sub SendEmail()

Dim OutlookApp As Object
'Dim OutlookApp As Outlook.Application
Dim MItem As Object
'Dim MItem As Outlook.MailItem

'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Set OutlookApp = New Outlook.Application

Dim Sendrng As Range
Set Sendrng = Worksheets("report").Range("C2:L63").SpecialCells(xlCellTypeVisible)

'Create Mail Item
Set MItem = OutlookApp.CreateItem(0)
'Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = "test@email.com"
.Subject = "report"
.CC = ""
.BCC = ""
.Body = "Email body text here"
End With

SendKeys "^({v})", True
With MItem
End With

Set OutlookApp = Nothing
Set MItem = Nothing

End Sub


MrExcel MVP
Instead of using the SendKeys method, use the WordEditor property of the Inspector object, which returns the Word Document object model...

With MItem
    .To = "test@email.com"
    .Subject = "report"
    .CC = ""
    .BCC = ""
    .Body = "Email body text here"
    With .GetInspector.WordEditor
        .Application.Selection.EndKey Unit:=6 'wdStory
    End With
End With
Hope this helps!


New Member
Thanks Domenic, finally got a chance to try it and that does the job great. Can you add a signature in Word mode? :)

Im now needing a second paste into the same email, any help with that?
VBA is running this filter, then copying the resulting visible cells into the above code:
wsDest.Range("$A$4:$BK$750").AutoFilter Field:=8, Criteria1:=Array("Core | Critical", "Core | No"), Operator:=xlFilterValues
wsDest.Range("$A$4:$BK$750").AutoFilter Field:=12, Criteria1:=Array("Today", "Future", "Today Future"), Operator:=xlFilterValues
It now needs to filter again and copy visible cells again in the email, below the other paste with a small gap of body text in between.
wsDest.Range("$A$4:$BK$750").AutoFilter Field:=8, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues
wsDest.Range("$A$4:$BK$750").AutoFilter Field:=12, Criteria1:=Array("Today", "Future", "Today Future"), Operator:=xlFilterValues

To create:
Paste 1
Body 2
Paste 2

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...