VBA to E-mail Worksheets as PDFs

[MSKapcala]

Hello! I need a little help with the following VBA from Mr. RDB. I am trying to take a master workbook with thousands of rows and break it down into multiple worksheets within the workbook based off of a column (It'll be agent number).

I have no issues with that, but now I want to e-mail those worksheets based off of an email address in the same column on each sheet and email it as a PDF AND use an outlook template.

I tried to mix it with the MACRO I have to e-mail multiple excel worksheets from outlook template, but I can't get it to work. Thanks.!!!

The code I am starting with is below:

Sub Mail_Every_Worksheet_With_Address_In_A1_PDF()
'This example works in Excel 2007 and Excel 2010.
Dim sh As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim FileName As String

'Set a temporary path to save the PDF files.
'You can also use another folder similar to
'TempFilePath = "C:\Users\Ron\MyFolder\"
TempFilePath = Environ$("temp") & "\"

'Loop through each worksheet.
For Each sh In ThisWorkbook.Worksheets
FileName = ""

'Test A1 for an e-mail address.
If sh.Range("A1").Value Like "?*@?*.?*" Then

'If there is an e-mail address in A1, create the file name and the PDF.
TempFileName = TempFilePath & "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"

FileName = RDB_Create_PDF(sh, TempFileName, True, False)


'If publishing is set, create the mail.
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, sh.Range("A1").Value, "This is the subject", _
"See the attached PDF file with the last figures" _
& vbNewLine & vbNewLine & "Regards Ron de bruin", False

'After the e-mail is created, delete the PDF file in TempFilePath.
If Dir(TempFileName) <> "" Then Kill TempFileName

Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"The path to save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If

End If
Next sh

 

[MSKapcala]

Here is my email from template MACRO:

Sub Mail_Every_Worksheet()</SPAN>
'Working in Excel 2000-2013</SPAN>
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm</SPAN>
Dim sh As Worksheet</SPAN>
Dim wb As Workbook</SPAN>
Dim FileExtStr As String</SPAN>
Dim FileFormatNum As Long</SPAN>
Dim TempFilePath As String</SPAN>
Dim TempFileName As String</SPAN>
Dim OutApp As Object</SPAN>
Dim OutMail As Object</SPAN>

TempFilePath = Environ$("temp") & "\"</SPAN>

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

With Application</SPAN>
.ScreenUpdating = False</SPAN>
.EnableEvents = False</SPAN>
End With</SPAN>

Set OutApp = CreateObject("Outlook.Application")</SPAN>

For Each sh In ThisWorkbook.Worksheets</SPAN>
If sh.Range</SPAN>("P2").</SPAN>Value Like "?*@?*.?*" Then</SPAN> ß</SPAN></SPAN>P2 refers to cell e-mail address is in.</SPAN></SPAN></SPAN>

sh.Copy</SPAN>
Set wb = ActiveWorkbook</SPAN>

TempFileName = "Agent-" & sh.Name & ""</SPAN>

Set OutMail = CreateObject("Outlook.Application")</SPAN>
Set MyItem = OutMail.CreateItemFromTemplate("C:\Users\Mkapd\AppData\Roaming\Microsoft\Templates\</SPAN>Direct Mail Template.oft"</SPAN>)</SPAN> ß</SPAN></SPAN>”Direct Mail Template” is name of e-mail template you want to use.</SPAN></SPAN></SPAN>
With wb</SPAN>
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum</SPAN>

On Error Resume Next</SPAN>
With MyItem</SPAN>
.To = sh.Range</SPAN>("P2")</SPAN>.Value</SPAN> ß</SPAN></SPAN>P2 refers to cell e-mail address is in.</SPAN></SPAN></SPAN>
.Subject = "</SPAN>ENTER E-MAIL SUBJECT</SPAN>"</SPAN> ß</SPAN></SPAN>Enter e-mail subject in quotes.</SPAN></SPAN></SPAN>
.Attachments.Add wb.FullName</SPAN>
'You can add other files also like this</SPAN>
'.Attachments.Add ("C:\test.txt")</SPAN>
.Send 'or use .Display</SPAN>
End With</SPAN>
On Error GoTo 0</SPAN>

.Close savechanges:=False</SPAN>
End With</SPAN>

Set OutMail = Nothing</SPAN>

Kill TempFilePath & TempFileName & FileExtStr</SPAN>

End If</SPAN>
Next sh</SPAN>

Set OutApp = Nothing</SPAN>

With Application</SPAN>
.ScreenUpdating = True</SPAN>
.EnableEvents = True</SPAN>
End With</SPAN>
End Sub</SPAN>