VBA Fill in multiple PDF Files

F

floggingmolly

Board Regular
Joined
Sep 14, 2019
Messages
167
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
floggingmolly said:
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
Click to expand...

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.
 
Upvote 0
DanteAmor said:
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.
Click to expand...

Thank you Dante. Your update worked. I got side tracked and just had a chance to try it today. I appreciate your help.
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Pasting Value with VBA - Sorta Looping based on a multiple of 30
Replies
2
Views
104
nmbc99
N
A
  • Question
Populate PDF checkbox with Application.SendKeys " "
Replies
0
Views
234
alxn
A
F
  • Question
VBA run code based off cell value
Replies
1
Views
306
igold
igold
J
  • Question
COMPILE ERROR: End With without With
Replies
5
Views
379
HaHoBe
HaHoBe
R
  • Solved
Macro that copies Excel data into pdf field doesn't always paste all the data
Replies
3
Views
624
RickOlson
R

Forum statistics

Threads
1,214,523
Messages
6,120,047
Members
448,940
Latest member
mdusw

Share this page

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
Back
Top