Help saving a autopopulate .pdf

[cskelk]

My code is working great for Printing to PDF, however today it finially dawned on me that if I print to PDF I will no longer have access to Blank Fillable boxes on my PDF, and I desperatly need that. So I'm asking for some help changing the code. Instead of Print to PDF I need SAVE AS. The file name has to remain the same

The First Macro picks the template doc

Sub PDFTemplate()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFilePicker)
With PDFFldr
.Title = "Select PDF file to Attach"
.Filters.Add "PDF Type Files", "*.pdf' , 1"
If .Show <> -1 Then GoTo NoSelection
Sheet2.Range("D8").Value = .SelectedItems(1)
End With
NoSelection:
End Sub


The second Macro you click a button and choose the folder you want to save the document in.

Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel
Sheet2.Range("D14").Value = .SelectedItems(1)
End With
NoSel:
End Sub

The Last Macro is another button to execute the population of the PDF

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, LastName As String
Dim CustRow, LastRow As Long
Dim Pluto As String
Pluto = Space(1)
With Sheet2
LastRow = .Range("A9999").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("D8").Value 'File Template Cell Location
SavePDFFolder = .Range("D14").Value 'Save Folder Cell Location
SaveDate = .Range("G16").Value ' File name Date
TrainingCode = .Range("E18").Value 'Cert Abreviation

ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00006

For CustRow = 26 To LastRow 'LastRow
Firstname = .Range("D" & CustRow).Value 'FirstName
middleInitial = .Range("C" & CustRow).Value 'Middle Initial
LastName = .Range("B" & CustRow).Value 'Last Name
Application.Wait Now + 0.00003
Application.SendKeys "{Tab}", True 'Name Box
Application.SendKeys Firstname, True
Application.SendKeys " ", True
Application.SendKeys middleInitial, True
Application.SendKeys ".", True
Application.SendKeys " ", True
Application.SendKeys LastName, True
Application.Wait Now + 0.00002

EmployeeSSN = .Range("E" & CustRow).Value
Application.SendKeys "{Tab}", True 'Employee SSN
Application.SendKeys EmployeeSSN, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
AcademyID = .Range("A" & CustRow).Value 'AcademyID
Application.SendKeys "Academy ID - ", True
Application.SendKeys AcademyID, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True

OJT = .Range("F" & CustRow).Value 'OJT
Application.SendKeys OJT, True
Application.Wait Now + 0.00003


Application.SendKeys "^(p)", True 'Print to PDF
Application.Wait Now + 0.00003
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00005

If Dir(SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf")
Application.SendKeys "%", True
Application.Wait Now + 0.00001
Application.SendKeys SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf"

Application.Wait Now + 0.00005
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00002

Next CustRow

Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True


End With
End Sub