Change the body of an email with VBA code

sknight22

Board Regular
Joined
Feb 16, 2016
Messages
75
Hello,


I am working on automating email for my workbook using the below code and need to add more content to the body of the email.


I have seen a few examples of how to add more lines but have so far been unable to get anything to work. Please can anyone advise?


Code:
Option Explicit




Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object


TempFilePath = Environ$("temp") & ""


If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsm": FileFormatNum = 52
End If


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


Set OutApp = CreateObject("Outlook.Application")


For Each sh In ThisWorkbook.Worksheets


If sh.Range("A1").Value Like "?*@?*.?*" Then


sh.Copy


Set wb = ActiveWorkbook


'Change all cells in the worksheet to values


With wb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells.PasteSpecial xlPasteFormats
End With


Application.CutCopyMode = False


TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


Set OutMail = OutApp.CreateItem(0)


With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum


On Error Resume Next
With OutMail
.To = sh.Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "S****HORPE ROD MILL COLLECTIONS"
.Body = "Please open both attachments and confirm ASAP"
.Attachments.Add wb.FullName


.Attachments.Add ("Z:\Safety\040 S****horpe Meet & Greet\Stephen\SRM EMAIL.docx")
.Send 'or use .Display
End With
On Error GoTo 0


.Close savechanges:=False
End With


Set OutMail = Nothing


Kill TempFilePath & TempFileName & FileExtStr


End If


Next sh


Set OutApp = Nothing


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


End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Forum statistics

Threads
1,215,011
Messages
6,122,680
Members
449,091
Latest member
peppernaut

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top