Hi. I'm trying to "save as" a PDF however seems that my codes are missing something and showing a dialog box I need to skip to go directly to the ThisWorkbook. Path. Im working of an Adobe Acrobat Reader DC which believe has a different short command from other apps.
Sub FillWorkshopPDFForm()
Dim PDFTemplateFile As String, NewPDFFile As String, SavePDFFolder As String, StudentName As String
Dim Subj As String, Mesg As String, EmailAdd As String
Dim StudentRow As Long, LastRow As Long
Dim OutApp As Object, OutMail As Object
If Sheet1.Range("E5").Value = Empty Then
MsgBox "Please select a PDF Template to use"
SetPDFTemplate
If Sheet1.Range("E5").Value = Empty Then Exit Sub
End If
PDFTemplateFile = Sheet1.Range("E5").Value 'Template File Name
With Sheet2
LastRow = .Range("A9999").End(xlUp).Row 'Last Student Row
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00002
For StudentRow = 3 To LastRow
If .Range("H" & StudentRow).Value = Empty Then
StudentName = .Range("A" & StudentRow).Value 'Student Name
EmailAdd = .Range("F" & StudentRow).Value 'Email Address
Subj = Replace(Sheet1.Range("E7").Value, "#Name#", StudentName) 'Email Subject
Mesg = Replace(Sheet1.Range("E9").Value, "#Name#", StudentName) 'Email Message
NewPDFFile = ThisWorkbook.Path & "\" & StudentName & "_Enrollment.pdf" 'New File Name
If Dir(NewPDFFile, vbDirectory) <> "" Then Kill (NewPDFFile) 'Deleted File if exists
'Add fields
Application.SendKeys "{Tab}", True
Application.SendKeys StudentName, True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys EmailAdd, True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys Format(.Range("G" & StudentRow).Value, "###-###-####"), True 'Phone #
Application.Wait Now + 0.00001
Application.SendKeys "+^(s)", True 'Save As
Application.Wait Now + 0.00001
Application.SendKeys NewPDFFile, True
Application.Wait Now + 0.00002
Application.SendKeys "^(s)" 'Save
Application.Wait Now + 0.00002
Below (1st) dialog box which I need to click "choose Diff Folder...:" just to be on the next Dialog Box
(2nd) Dialog Box
Sub FillWorkshopPDFForm()
Dim PDFTemplateFile As String, NewPDFFile As String, SavePDFFolder As String, StudentName As String
Dim Subj As String, Mesg As String, EmailAdd As String
Dim StudentRow As Long, LastRow As Long
Dim OutApp As Object, OutMail As Object
If Sheet1.Range("E5").Value = Empty Then
MsgBox "Please select a PDF Template to use"
SetPDFTemplate
If Sheet1.Range("E5").Value = Empty Then Exit Sub
End If
PDFTemplateFile = Sheet1.Range("E5").Value 'Template File Name
With Sheet2
LastRow = .Range("A9999").End(xlUp).Row 'Last Student Row
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00002
For StudentRow = 3 To LastRow
If .Range("H" & StudentRow).Value = Empty Then
StudentName = .Range("A" & StudentRow).Value 'Student Name
EmailAdd = .Range("F" & StudentRow).Value 'Email Address
Subj = Replace(Sheet1.Range("E7").Value, "#Name#", StudentName) 'Email Subject
Mesg = Replace(Sheet1.Range("E9").Value, "#Name#", StudentName) 'Email Message
NewPDFFile = ThisWorkbook.Path & "\" & StudentName & "_Enrollment.pdf" 'New File Name
If Dir(NewPDFFile, vbDirectory) <> "" Then Kill (NewPDFFile) 'Deleted File if exists
'Add fields
Application.SendKeys "{Tab}", True
Application.SendKeys StudentName, True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys EmailAdd, True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys Format(.Range("G" & StudentRow).Value, "###-###-####"), True 'Phone #
Application.Wait Now + 0.00001
Application.SendKeys "+^(s)", True 'Save As
Application.Wait Now + 0.00001
Application.SendKeys NewPDFFile, True
Application.Wait Now + 0.00002
Application.SendKeys "^(s)" 'Save
Application.Wait Now + 0.00002
Below (1st) dialog box which I need to click "choose Diff Folder...:" just to be on the next Dialog Box
(2nd) Dialog Box