Email .xlsx as .PDF

[Jaegar]

Below is a script I am using which runs solidly up to the point where I need the final output format to be .pdf instead of .xlsx

I have the necessary addon for Excel and have tried to set the point

FileExtStr = ".xlsx": FileFormatNum = 51

to

FileExtStr = ".pdf": FileFormatNum = 17

However this does not seem to work. Are there any adaptations that can be made to ensure the correct output?
A few people on here seem to have this problem and none have yet had their prayers answered!

Below is the full instance of code

Private Sub Preview_Click()
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:F43")
    On Error GoTo 0
    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial paste:=8
        .Cells(1).PasteSpecial paste:=1
        .Cells(1).PasteSpecial paste:=xlPasteFormats
        .Rows(1).RowHeight = 66
        .Rows(2).RowHeight = 66
        .Rows(3).RowHeight = 34
        .Range("4:12").RowHeight = 21
        .Range("14:25").RowHeight = 19
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
 
    With ActiveSheet.Pictures.Insert("C:\Image.jpg")
        .Left = ActiveSheet.Range("A1").Left
        .Top = ActiveSheet.Range("A1").Top
    End With
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Order Number " & Range("D43") & " " _
                 & Format(Now, "dd-mmm-yy")
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = 56
    Else
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = Range("A48")
            .CC = ""
            .BCC = ""
            .Subject = "Company Name" & Range("D43")
            .Body = "Please find attached our order." & vbCrLf & " " & vbCrLf & "Thanks, Carolyn"
            .Attachments.Add Dest.FullName
            .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
End Sub

 

[Jaegar]

The only other choice is xlQualityMinimum.

That sucks - ah well - thanks for all of your help!

 

[japaro]

I'm using your code, everything works fine, except the person in the function
With OutMail
. To = Range ("A48")

I need only that, please i would be very useful to help to complete the file.
Thanks