VBA Fill in multiple PDF Files

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
85
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

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,619
Office Version
  1. 2007
Platform
  1. 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
85
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
12,619
Office Version
  1. 2007
Platform
  1. 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
12,619
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,128,122
Messages
5,628,827
Members
416,342
Latest member
BlueDevil12

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top