Converting an excel sheet to PDF and attaching it to an email

[Godot60]

I have created VBA code that checks to see if certain cells on a form have been filled out and then attaches the excel sheet to an email. What I need to do is send the attachment as a pdf instead. I'm at a loss for how I would change the code (see below). Any suggestions appreciated. Thanks!

Sub Mail_small_Text_Outlook()


If Range("f8").Value = "" Or Range("f10").Value = "" Or Range("a29").Value = "" Or Range("j10").Value = "" Or Range("f12").Value = "" Or Range("f14").Value = "" Or Range("k14").Value = "" Or Range("f16").Value = "" Or Range("k16").Value = "" Or Range("H25").Value = "" Or Range("f18").Value = "" Then
MsgBox "Please complete all required fields"
Exit Sub
End If




Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Extension request for: " & Sheet1.Range("j10") & vbNewLine & _
"Department: " & Sheet1.Range("f12") & vbNewLine & _
"Classification: " & Sheet1.Range("f18") & vbNewLine & _
"Extension details: " & Sheet1.Range("f20") & vbNewLine & _
"Requestor: " & Sheet1.Range("f14")


On Error Resume Next
With OutMail
.To = "joe.smith@awese.edu"
.CC = ""
.BCC = ""
.Subject = "Extension request for: " & Sheet1.Range("j10")
.Body = strbody
.Attachments.Add ActiveWorkbook.FullName
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[Domenic]

In amending your code, I assumed that Sheet1 is the sheet with all of the relevant information, and is the sheet to be exported and attached as a PDF file. Change the sheet name, if necessary.

Option Explicit

Sub Mail_small_Text_Outlook()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim CurrentCell As Range
    Dim strFileName As String
    Dim strbody As String
    
    For Each CurrentCell In Sheet1.Range("a29, f8, f10, f12, f14, f16, f18, h25, j10, k14, k16")
        If CurrentCell.Value = "" Then
            MsgBox "Please complete all required fields.", vbExclamation
            Exit Sub
        End If
    Next CurrentCell


    strFileName = ActiveWorkbook.FullName
    strFileName = Left(strFileName, InStrRev(strFileName, ".", , vbTextCompare) - 1) & ".pdf"
    
    Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName
    
    strbody = "Extension request for: " & Sheet1.Range("j10") & vbNewLine & _
        "Department: " & Sheet1.Range("f12") & vbNewLine & _
        "Classification: " & Sheet1.Range("f18") & vbNewLine & _
        "Extension details: " & Sheet1.Range("f20") & vbNewLine & _
        "Requestor: " & Sheet1.Range("f14")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = "joe.smith@awese.edu"
        .CC = ""
        .BCC = ""
        .Subject = "Extension request for: " & Sheet1.Range("j10")
        .Body = strbody
        .Attachments.Add strFileName
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display 'or use .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set CurrentCell = Nothing
    
End Sub

Hope this helps!

 

[Godot60]

Thanks so much. Works perfectly!