VBA Fill in multiple PDF Files

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
67
I have a code to fill in multiple PDF files from data in an excel sheet. It gets data from the first row and fills in the pdf and saves it. Then I need it to go to each line and fill in a new pdf and save it. When it creates the first pdf and saves it, a preview of the pdf comes up. Then the macro keeps running and saving but every pdf has the same information as the first one. Anybody have any suggestions how to prevent the pdf preview from coming up after it saves the file and then to continue creating a new pdf for each line of data in the sheet? Here is the code i have:
Code:
Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, LastName As String
Dim ApptDate As Date
Dim CustRow, LastRow As Long
With Sheet1
If .Range("G18").Value = Empty Or .Range("G20").Value = Empty Then
    MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
    Exit Sub
End If

LastRow = .Range("E9999").End(xlUp).Row  'Last Row
PDFTemplateFile = .Range("G18").Value 'Template File Name
SavePDFFolder = .Range("G20").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00006

For CustRow = 5 To LastRow
LastName = .Range("E" & CustRow).Value 'Last Name
ApptDate = .Range("G" & CustRow).Value 'Appt Date
Application.SendKeys "{Tab}", True
Application.SendKeys LastName, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("F" & CustRow).Value, True 'First Name
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("I" & CustRow).Value, True 'Address
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("J" & CustRow).Value, True 'City
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("K" & CustRow).Value, True 'State
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("L" & CustRow).Value, True 'Zip
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True

Application.SendKeys .Range("M" & CustRow).Value, True 'Email
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.SendKeys "{Tab}", True

Application.SendKeys Format(.Range("N" & CustRow).Value, "###-###-####"), True 'Phone
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.00007

If Dir(SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf")
Application.SendKeys "%(n)", True
Application.Wait Now + 0.00002
Application.SendKeys SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf"
Application.Wait Now + 0.00003
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00002


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

End With
End Sub
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,161
Office Version
2007
Platform
Windows
Try opening the file, load the data and close the file for each record.
I also added the DoEventes instruction to execute the command.

Code:
Sub CreatePDFForms()
  Dim PDFTemplateFile, NewPDFName, SavePDFFolder, LastName As String
  Dim ApptDate As Date
  Dim CustRow, LastRow As Long
  With Sheet1
    If .Range("G18").Value = Empty Or .Range("G20").Value = Empty Then
        MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
        Exit Sub
    End If
    
    LastRow = .Range("E9999").End(xlUp).Row  'Last Row
    PDFTemplateFile = .Range("G18").Value 'Template File Name
    SavePDFFolder = .Range("G20").Value 'Save PDF Folder
    
    For CustRow = 5 To LastRow
[COLOR=#0000ff]      ThisWorkbook.FollowHyperlink PDFTemplateFile[/COLOR]
      Application.Wait Now + 0.00006
[COLOR=#008000]      DoEvents[/COLOR]
      
      LastName = .Range("E" & CustRow).Value 'Last Name
      ApptDate = .Range("G" & CustRow).Value 'Appt Date
      Application.SendKeys "{Tab}", True
      Application.SendKeys LastName, True
      Application.Wait Now + 0.00001
      DoEvents
      
      Application.SendKeys "{Tab}", True
      Application.SendKeys .Range("F" & CustRow).Value, True 'First Name
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      Application.SendKeys "{Tab}", True
      [COLOR=#008000]DoEvents[/COLOR]
      
      Application.SendKeys .Range("I" & CustRow).Value, True 'Address
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
[COLOR=#008000]      DoEvents[/COLOR]
      
      Application.SendKeys .Range("J" & CustRow).Value, True 'City
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      [COLOR=#008000]DoEvents[/COLOR]
      
      Application.SendKeys .Range("K" & CustRow).Value, True 'State
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      [COLOR=#008000]DoEvents[/COLOR]
      
      Application.SendKeys .Range("L" & CustRow).Value, True 'Zip
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      DoEvents
      
      Application.SendKeys .Range("M" & CustRow).Value, True 'Email
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      Application.SendKeys "{Tab}", True
      [COLOR=#008000]DoEvents[/COLOR]
      
      Application.SendKeys Format(.Range("N" & CustRow).Value, "###-###-####"), True 'Phone
      Application.Wait Now + 0.00001
      Application.SendKeys "{Tab}", True
      [COLOR=#008000]DoEvents[/COLOR]
      
      Application.SendKeys "^(p)", True
      Application.Wait Now + 0.00003
      Application.SendKeys "{Enter}", True
      Application.Wait Now + 0.00007
      [COLOR=#008000]DoEvents[/COLOR]
      
      If Dir(SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf")
      Application.SendKeys "%(n)", True
      Application.Wait Now + 0.00002
      Application.SendKeys SavePDFFolder & "\" & LastName & "_" & Format(ApptDate, "DD_MM_YYYY") & ".pdf"
      Application.Wait Now + 0.00003
      Application.SendKeys "%(s)", True
      Application.Wait Now + 0.00002
      [COLOR=#008000]DoEvents[/COLOR]
    
[COLOR=#0000ff]      Application.SendKeys "^(q)", True[/COLOR]
      [COLOR=#008000]DoEvents[/COLOR]
    
    Next CustRow
    Application.SendKeys "{numlock}%s", True
  
  End With
End Sub
 

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
67
Thank you for the response. I tried the updated code but same result. How can I open the file, load data, an close the file for each record? It fills in the first one but then it doesn't load a new one
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,161
Office Version
2007
Platform
Windows
Thank you for the response. I tried the updated code but same result.

How can I open the file, load data, an close the file for each record?
I don't understand the question, the update does that:
Code:
   [COLOR=#008000] For CustRow = 5 To LastRow[/COLOR]
'Open file
      [COLOR=#ff0000]ThisWorkbook.FollowHyperlink PDFTemplateFile[/COLOR]
'Load data
'...
'
'Close file
[COLOR=#ff0000]      Application.SendKeys "^(q)", True[/COLOR]
      DoEvents
    
[COLOR=#008000]    Next CustRow[/COLOR]
It fills in the first one but then it doesn't load a new one
Another option is to reproduce the PDF format on an excel sheet, fill out the sheet and save as pdf and so for each record.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,161
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,629
Messages
5,445,577
Members
405,341
Latest member
AzureStoneDog

This Week's Hot Topics

Top