Macro to e-mail each worksheet as a pdf

[cvanooyen]

Hello Everyone-

Long time reader, first time poster. I am working on a macro to e-mail each worksheet in excel file to a different email address. I have it successfully emailing the files as an .xlsx file, but I need the file to be a .pdf.

I am an amateur at best when it comes to coding, but I been peicing different codes together that I have found online.

Any help would be amazing. The code I am currently using is below. Thanks a bunch in advance for any help.

Sub Mail_Every_Worksheet()
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
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
TempFileName = sh.Name & " - July 2014"
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 = sh.Name & " - July 2014"
.Body = "Please review"
.Attachments.Add wb.FullName
.Send
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