Change the body of an email with VBA code

S

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

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Sort by date Sort by votes
here is one way of doing it, if you need to add in some text which is fixed by you

add

Set OutApp = CreateObject("Outlook.Application")

mBody = "line of text here" & vbNewLine & _
"another line of text here"


For Each sh In ThisWorkbook.Worksheets

then in the email settings up date it to

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

You can adda as many bodys as you like lets say mBody & sBody & strBody & so on

hope this helps, if you need to build an email body from a sheet with text on instead of embedding t in VBA let me know

Paul Xmw
 
Last edited:
Upvote 0
Hi Paul,

Thanks for your response. I have entered the code and ran but getting an error "Compile Error: Variable not defined". and "mBody =" in the below is highlighted

any ideas what could be wrong?

Thanks
sknight

Code: 
Set OutApp = CreateObject("Outlook.Application")


mBody = "line of text here" & vbNewLine & _
"another line of text here"




For Each sh In ThisWorkbook.Worksheets
 
Upvote 0
Hi I dont know why you got an error, Here is what i used you can also choose to insert text from a sheet if theres a lot to put in the email if you need to do this just ask

Code: 
Private Sub CommandButton1_Click()

'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")

mBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "3rd line here" & vbNewLine & _
        " " & vbNewLine & _
        ""
        
        
sBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "yet another line here" & vbNewLine & _
        " " & vbNewLine & _
        ""
        
tBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "forth line here" & vbNewLine

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 = "My test email with attachements"
.Body = mBody & sBody & tBody
.Attachments.Add wb.FullName


.Attachments.Add ("D:/utills/New sheet")
.Display '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
 
Last edited:
Upvote 0
Hi You could also try the code below
Code: 
Private Sub CommandButton1_Click()

'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")

mBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "3rd line here" & vbNewLine & _
        " " & vbNewLine & _
        ""
        
        
sBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "yet another line here" & vbNewLine & _
        " " & vbNewLine & _
        ""
        
tBody = "line of text here" & vbNewLine & _
        "another line of text here" & vbNewLine & _
        "forth line here" & vbNewLine

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 = "My test email with attachements"
.Attachments.Add wb.FullName
.Body = "Dear Colleague," & _
 "Please see attached list of invoices that are require approval." & vbNewLine & _
 "this is the second line of text to be sent in this email" & vbNewLine & _
 "this is the thired line of tect to be sent in this email" & vbNewLine & _
 "This is the forth line of text to be sent in this email" & vbNewLine & vbNewLine & _
 " I am a new paragraph in this email" & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
 " this line wants to distence its self from the other text"

 



.Attachments.Add ("D:/utills/New sheet")
.Display '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
 
Last edited:
Upvote 0
sknight22

You need to declare the variable mbody, add this at the top of your code alongside the rest of the declarations.
Code: 
Dim mbody As String
 
Upvote 0
this is what i thought originally, however you dont need to include mBody as String it works without it, try the coed i posted it works with no issues
 
Upvote 0
paulxmw

When I tried the code you posted I was prompted 4 times by the VBA editor telling me 'Variable not defined.'.

That's probably, be default, I have Option Explicit at the top of every module I create/use.:)
 
Upvote 0
Hi Norie

I originally tried the code in a Command button [Private Sub CommandButton1_Click() ]and it worked fine i also tried it on worksheet Change and Worksheet deactivate and it worked fine but if you put it into a module you will need to have a line at the top describing whats in the module like Send_Email_1 then i used a Command button to call the macro as below

Private Sub CommandButton1_Click()
Call Send_Email_Email_1
End Sub

give it a try i have had no issues sending emails (in Display) with this code so far

Paul
 
Last edited:
Upvote 0
Paul

The reason the code didn't compile for me is because I had Option Explicit at the top of the module.

Option Explicit forces you to declare all variables and though it can be a bit annoying is a very useful thing to have when writing/debugging code.

Under Tools>Options... on the Editor tab if you check Require Variable Declaration then Option Explicit will be added to all new modules by default.

PS I'm not saying there's anything wrong with your code, trying to explain why it failed for the OP.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
VBA copy Values exclude 1 column and formula
Replies
2
Views
274
bombergirl61
B
M
  • Question Question
Email file VBA - change attachment from excel to PDF?
Replies
2
Views
233
MOB
M
H
  • Question Question
Macro to email Report
Replies
2
Views
529
howard
H
M
  • Question Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
491
mecerrato
M
catscantuseexcel
  • Solved
VBA to send sheets based on column values
Replies
3
Views
941
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

Share this page

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