Hi,
I'm not too experienced with VBA so resort to lots of Google searching and trial and error. I am trying to have Excel create one email for each Worksheet that has an email address in cell L2. Currently my macro successfully creates an email, attaches each worksheet as a workbook, and populates the to field with the email address in L2.
I am trying to tweak the code so that rather than attach a file, the range of A1: J (last row with data) is copy and pasted into the body of the email. Any help would be greatly appreciated.
I'm not too experienced with VBA so resort to lots of Google searching and trial and error. I am trying to have Excel create one email for each Worksheet that has an email address in cell L2. Currently my macro successfully creates an email, attaches each worksheet as a workbook, and populates the to field with the email address in L2.
I am trying to tweak the code so that rather than attach a file, the range of A1: J (last row with data) is copy and pasted into the body of the email. Any help would be greatly appreciated.
Code:
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 = ".xls": 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("L2").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
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("L2").Value
.cc = ""
.BCC = ""
.Subject = Date & " " & " Allocations"
.Body = "Hello"
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Save '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