How to save current sheet to PDF and email with Outlook using Excel VBA?

Question

I've the task of finding or creating a new macro module that will save only the current sheet to PDF format (to the temp folder).

All I have been able to find that is close to what I want to do is what I have attached. This prompts the user for a save location.

How can I change this to, not prompt for save location and, save to the temp folder and then attach the pdf in an email through Outlook.

Sub Saveaspdfandsend()
    Dim xSht As Worksheet
    Dim xFileDlg As FileDialog
    Dim xFolder As String
    Dim xYesorNo As Integer
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim xUsedRng As Range
 
    Set xSht = ActiveSheet
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
 
    If xFileDlg.Show = True Then
       xFolder = xFileDlg.SelectedItems(1)
    Else
       MsgBox "You must specify a folder to save the PDF into." & vbCrLf & 
    vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify 
    Destination Folder"
       Exit Sub
    End If
    xFolder = xFolder + "\" + xSht.Name + ".pdf"
 
    'Check if file already exist
    If Len(Dir(xFolder)) > 0 Then
        xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & 
    "Do you want to overwrite it?", _
                          vbYesNo + vbQuestion, "File Exists")
        On Error Resume Next
        If xYesorNo = vbYes Then
            Kill xFolder
        Else
            MsgBox "if you don't overwrite the existing PDF, I can't 
    continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", 
    vbCritical, "Exiting Macro"
            Exit Sub
        End If
        If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file 
    is not open or write protected." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", 
    vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If
 
    Set xUsedRng = xSht.UsedRange
    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
        'Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, 
    Quality:=xlQualityStandard
     
        'Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
    Else
      MsgBox "The active worksheet cannot be blank"
      Exit Sub
    End If
End Sub

Answer 1

In summary, you have all you need in code you had attached:

Delete this this is the prompt to select destination.

Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & 
vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify 
Destination Folder"
   Exit Sub
End If

After deleting this, you would have to add either string to path were to save file, i would suggest using some cell reference for that, as if you code that you might have some issue.

Nevertheless, in place of previously deleted lines insert:

xFolder = C:\fullpath\filename.pdf

although i would suggest:

xFolder = ThisWorkbook.Sheets("Setup").Range("A1") 'something in those lines, you could name sheet to be safer. 

Leave the part that checks if file exists, it may become handy as sometimes if you use shared drives they might be blocked by someone else and kill function will not work.

Rest should be fine.