Livin404
Well-known Member
- Joined
- Jan 7, 2019
- Messages
- 743
- Office Version
- 365
- 2019
- Platform
- Windows
Greetings, I have pasted my whole VBA for a product I have where it will OPEN, WRITE, and SAVE a PDF and it does work. They are boarding passes, and we can have any where from 1 to 300 and they will all be the same except for the name. However without fail it seems only the second one always fills in the wrong blocks, then after that it works great. I'm not sure if it is a timing thing or some other glitch. In addition, I have to save to "Microsoft Print to PDF" because of the security settings our admin has for the PDF. I would like to save it as Adobe PDF but It has a button I need to press that "Enables All Features". Is there a code I can use that will "Enable All Features" and where would it be placed. If I can save it as Adobe PD,F then I can make edits to the form if needed once the macro is run. Thank you so much!
VBA Code:
Option Explicit
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
Sheet3.Range("B2").Value = .SelectedItems(1)
End With
NoSelection:
End Sub
Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel:
Sheet3.Range("B3").Value = .SelectedItems(1)
End With
NoSel:
End Sub
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, AMC148Short, FlightNumber As String
Dim Name As String
Dim NameRow, Lastrow As Long
With Sheet3
Lastrow = .Range("A450").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("B2").Value 'Template File Name
AMC148Short = .Range("B3").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00006
For NameRow = 6 To Lastrow
Name = .Range("A" & NameRow).Value 'Full Name
FlightNumber = .Range("B" & NameRow).Value 'Flight Number
Application.SendKeys "{Tab}", True
Application.SendKeys Name, True
Application.Wait Now + 0.00003
Application.SendKeys "{Tab}", True
Application.SendKeys .Range("B" & NameRow).Value, True 'Flight Number
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys .Range("C" & NameRow).Value, True 'Line #
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys "^(p)", True
Application.Wait Now + 0.00003
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00006
If Dir(AMC148Short & "\" & FlightNumber & "_" & Name & ".pdf") <> Empty Then Kill (AAA148Short & "\" & FlightNumber & "_" & Name & ".pdf")
Application.SendKeys "%(n)", True
Application.Wait Now + 0.00002
Application.SendKeys AAA148Short & "\" & FlightNumber & "_" & Name & ".pdf"
Application.Wait Now + 0.00003
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00003
Next NameRow
Application.SendKeys "^(q)", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00002
Application.SendKeys "{numlock}%s", True
End With
End Sub