Excel Export Cells to PDF Forms (fillable)

**DarinM** · 10-08-2015, 10:27 AM

Hi Ken,

starting to edit my real document, and I am running into an error whenever I try to add more lines, I tried fixing it myself but i said "too many continuations".

the error is "compile error: expected: line number or label or statement or end of statement".

the top and bottom parts dont match yet, but i figure ill keep running into that error once done and hoping you'll reply by then

any idea?

 ' Builds string for contents of FDF file and then writes file to workbook folder.    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
    "%âãÏÓ" & vbCrLf & _
    "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
    "endobj" & vbCrLf & _
    "2 0 obj[" & vbCrLf
     
    sFileFooter = "]" & vbCrLf & _
    "endobj" & vbCrLf & _
    "trailer" & vbCrLf & _
    "<</Root 1 0 R>>" & vbCrLf & _
    "%%EO"
     
    sFileFields = "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf & _
    "<</T(EnikaTitle)/V(EnikaTitle)>>" & vbCrLf & _
    "<</T(Enika)/V(Enika)>>" & vbCrLf & _
    "<</T(CustomerInfoName)/V(CustomerInfoName)>>" & vbCrLf & _
    "<</T(TM)/V(TM)>>" & vbCrLf & _
    "<</T(TMTitle)/V(TMTitle)>>" & vbCrLf & _
    "<</T(CustomerInfoAddress)/V(CustomerInfoAddress)>>" & vbCrLf _
    "<</T(CustomerInfoCity)/V(CustomerInfoCity)>>" & vbCrLf & _
    "<</T(CustomerInfoPostal)/V(CustomerInfoPostal)>>" & vbCrLf & _
    "<</T(CustomerInfoDate1)/V(CustomerInfoDate1)>>" & vbCrLf & _
    "<</T(CustomerInfoDate2)/V(CustomerInfoDate2)>>" & vbCrLf & _
    "<</T(Q1Bonus)/V(Q1Bonus)>>" & vbCrLf & _
    "<</T(Q1BonusNumber)/V(Q1BonusNumber)>>" & vbCrLf
    "<</T(Q2Bonus)/V(Q2Bonus)>>" & vbCrLf & _
    "<</T(Q2BonusNumber)/V(Q2BonusNumber)>>" & vbCrLf & _
    "<</T(Q3Bonus)/V(Q3Bonus)>>" & vbCrLf & _
    "<</T(Q3BonusNumber)/V(Q3BonusNumber)>>" & vbCrLf & _
    "<</T(Q4Bonus)/V(Q4Bonus)>>" & vbCrLf & _
    "<</T(Q4BonusNumber)/V(Q4BonusNumber)>>" & vbCrLf
    "<</T(OpeningBalanceDate)/V(OpeningBalanceDate)>>" & vbCrLf & _
    "<</T(OABDate1)/V(OABDate1)>>" & vbCrLf & _
    "<</T(OpeningBalance)/V(OpeningBalance)>>" & vbCrLf & _
    "<</T(OABName1)/V(OABName1)>>" & vbCrLf & _
    "<</T(OABNumber1)/V(OABNumber1)>>" & vbCrLf & _
    "<</T(OABDate2)/V(OABDate2)>>" & vbCrLf
    "<</T(OABName2)/V(OABName2)>>" & vbCrLf & _
    "<</T(OABDate3)/V(OABDate3)>>" & vbCrLf & _
    "<</T(OABName3)/V(OABName3)>>" & vbCrLf & _
    "<</T(OABNumber3)/V(OABNumber3)>>" & vbCrLf & _
    "<</T(OABDate4)/V(OABDate4)>>" & vbCrLf & _
    "<</T(OABName4)/V(OABName4)>>" & vbCrLf
    "<</T(OABNumber4)/V(OABNumber4)>>" & vbCrLf & _
    "<</T(city)/V(---CITY---)>>" & vbCrLf & _
    "<</T(postal)/V(---POSTAL---)>>" & vbCrLf & _
    "<</T(opening)/V(---OPENING---)>>" & vbCrLf & _
    "<</T(month)/V(---MONTH---)>>" & vbCrLf & _
    "<</T(balance)/V(---BALANCE---)>>" & vbCrLf
    "<</T(address)/V(---ADDRESS---)>>" & vbCrLf & _
    "<</T(city)/V(---CITY---)>>" & vbCrLf & _
    "<</T(postal)/V(---POSTAL---)>>" & vbCrLf & _
    "<</T(opening)/V(---OPENING---)>>" & vbCrLf & _
    "<</T(month)/V(---MONTH---)>>" & vbCrLf & _
    "<</T(balance)/V(---BALANCE---)>>" & vbCrLf
    "<</T(address)/V(---ADDRESS---)>>" & vbCrLf & _
    "<</T(city)/V(---CITY---)>>" & vbCrLf & _
    "<</T(postal)/V(---POSTAL---)>>" & vbCrLf & _
    "<</T(opening)/V(---OPENING---)>>" & vbCrLf & _
    "<</T(month)/V(---MONTH---)>>" & vbCrLf & _
    "<</T(balance)/V(---BALANCE---)>>" & vbCrLf
    
     
    sFileFields = Replace(sFileFields, "CustomerInfoBusiness", Range("CustomerInfoBusiness").Value)
    sFileFields = Replace(sFileFields, "EnikaTitle", Range("EnikaTitle").Value)
    sFileFields = Replace(sFileFields, "Enika", Range("Enika").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoName", Range("CustomerInfoName").Value)
    sFileFields = Replace(sFileFields, "TM", Range("TM").Value)
    sFileFields = Replace(sFileFields, "TMTitle", Range("TMTitle").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoAddress", Range("CustomerInfoAddress").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoCity", Range("CustomerInfoCity").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoPostal", Range("CustomerInfoPostal").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate1", Range("CustomerInfoDate1").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate2", Range("CustomerInfoDate2").Value)
    sFileFields = Replace(sFileFields, "Q1Bonus", Range("Q1Bonus").Value)
    sFileFields = Replace(sFileFields, "Q1BonusNumber", Range("Q1BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q2Bonus", Range("Q2Bonus").Value)
    sFileFields = Replace(sFileFields, "Q2BonusNumber", Range("Q2BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q3Bonus", Range("Q3Bonus").Value)
    sFileFields = Replace(sFileFields, "Q3BonusNumber", Range("Q3BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q4Bonus", Range("Q4Bonus").Value)
    sFileFields = Replace(sFileFields, "Q4BonusNumber", Range("Q4BonusNumber").Value)
    sFileFields = Replace(sFileFields, "OpeningBalanceDate", Range("OpeningBalanceDate").Value)
    sFileFields = Replace(sFileFields, "OABDate1", Range("OABDate1").Value)
    sFileFields = Replace(sFileFields, "OpeningBalance", Range("OpeningBalance").Value)
    sFileFields = Replace(sFileFields, "OABName1", Range("OABName1").Value)
    sFileFields = Replace(sFileFields, "OABNumber1", Range("OABNumber1").Value)
    sFileFields = Replace(sFileFields, "OABDate2", Range("OABDate2").Value)
    sFileFields = Replace(sFileFields, "OABName2", Range("OABName2").Value)
    sFileFields = Replace(sFileFields, "OABDate3", Range("OABDate3").Value)
    sFileFields = Replace(sFileFields, "OABName3", Range("OABName3").Value)
    sFileFields = Replace(sFileFields, "OABNumber3", Range("OABNumber3").Value)
    sFileFields = Replace(sFileFields, "OABDate4", Range("OABDate4").Value)
    sFileFields = Replace(sFileFields, "OABName4", Range("OABName4").Value)
    sFileFields = Replace(sFileFields, "OABNumber4", Range("OABNumber4").Value)
    sFileFields = Replace(sFileFields, "---CITY---", Range("City").Value)
    sFileFields = Replace(sFileFields, "---POSTAL---", Range("Postal").Value)
    sFileFields = Replace(sFileFields, "---OPENING---", Range("Opening").Value)
    sFileFields = Replace(sFileFields, "---MONTH---", Range("Month").Value)
    sFileFields = Replace(sFileFields, "---BALANCE---", Range("Balance").Value)
     
    sTmp = sFileHeader & sFileFields & sFileFooter

**Kenneth Hobs** · 10-08-2015, 10:32 AM

Fill an array and then use Join() is the most efficient way to do long strings.

The more simple way is to use string concatenation. e.g.

sFileFields = "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf & _ 
"<</T(EnikaTitle)/V(EnikaTitle)>>" & vbCrLf
sFileFields = sFileFields & "<</T(Enika)/V(Enika)>>" & vbCrLf
'etc.

Sort of to that end, I made this. It seemingly works but does not fill the form. I have not had time to figure that out yet but the concepts may interest you.

Sub Main()    
  Dim mainPDF As String, aNames() As String, s As String
    Dim c As Range, sFilename As String
    
    'Build array of Names for FDF file from current workbook of Names to insert
    s = "NAME,ADDRESS,CITY,POSTAL,OPENING,MONTH,BALANCE"
    aNames() = Split(s, ",")
    s = MissingNames(aNames())
    If s <> "" Then
      MsgBox s, vbCritical, "Missing Names - Macro Ending"
      Exit Sub
    End If
     
    'Creat the pdf form file's name with fields to fill
    Select Case LCase(Worksheets("Sheet1").Range("A2").Value2)
    Case "gold"
        mainPDF = "csGold.pdf"
    Case "silver"
        mainPDF = "csSilver.pdf"
    Case Else
        mainPDF = "cstest.pdf"
    End Select
    s = ThisWorkbook.Path & "\" & mainPDF
    If Len(Dir(s)) = 0 Then
        MsgBox s, vbCritical, "Missing File - Macro Ending"
        Exit Sub
    End If
    
    'Create the FDFfilename, sFilename
    If Len(Range("Account").Value) Then
        sFilename = Range("Account").Value
    Else: sFilename = "FDF_DEMOTEST"
    End If
    sFilename = ActiveWorkbook.Path & "\" & sFilename & ".fdf"
     
    MakeFDF2 aNames(), mainPDF, sFilename
End Sub


Function MissingNames(sNames() As String) As String
  Dim c As Range, v As Variant, s As String
  For Each v In sNames()
    Set c = Nothing
    On Error Resume Next
    Set c = Range(v)
    If c Is Nothing Then s = s & v & vbCrLf
  Next v
  MissingNames = s
End Function
 
Public Sub MakeFDF2(sNames() As String, Optional PDF_FILE As String = "cstest.pdf", _
  Optional fdfFilename As String = "FDF_DEMOTEST")
    Dim sFileHeader As String, sFileFooter As String, sFileFields As String
    Dim sFilename As String, sTmp As String, lngFileNum As Long
    Dim v As Variant
     
     ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
    "%âãÏÓ" & vbCrLf & _
    "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
    "endobj" & vbCrLf & _
    "2 0 obj[" & vbCrLf
     
    sFileFooter = "]" & vbCrLf & _
    "endobj" & vbCrLf & _
    "trailer" & vbCrLf & _
    "<</Root 1 0 R>>" & vbCrLf & _
    "%%EO"
     
    For Each v In sNames()
      sFileFields = sFileFields & "<</T(" & v & ")/V(" & Range(v).Value2 & ")>>" & vbCrLf
    Next v
    Debug.Print sFileFields
    
    sTmp = sFileHeader & sFileFields & sFileFooter


    lngFileNum = FreeFile
    Open fdfFilename For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
        
     ' Open FDF file as PDF
     Shell "cmd /c " & """" & fdfFilename & """", vbNormalFocus
     
    Exit Sub
ErrorHandler:
    MsgBox "MakeFDF Error: " + str(Err.Number) + " " + Err.Description + " " + Err.Source
End Sub

**DarinM** · 10-08-2015, 10:43 AM

Ah, I will add the sFileFields portion to it and will try.

after i'm done copy/pasting the rest of the fields i will look at your second code portion.

thanks for the quick reply, super appreciated!

**DarinM** · 10-08-2015, 12:46 PM

Hi Ken,

I edited it manually and 1 by 1, incase I need to do more funky things... i'm sure you are shivering at the manual-ness of this hahah. I do have an error when I open it though. I have attached all files here for you, can you take a peak? It looks like it should work to me (based on the last one that DID work...)

I couldn't upload all 5 pdf's, so you'll have to copy/paste them and rename to test, or just remove the "if gold =gold.pdf" etc.

Appreciate it again...and again!!

Option Explicit 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Sub Main()
    Dim mainPDF As String
     
    Select Case LCase(Worksheets("Statement").Range("I24").Value2)
    Case "platinum"
        mainPDF = "aspireplatinum.pdf"
    Case "gold"
        mainPDF = "aspiregold.pdf"
    Case "silver"
        mainPDF = "aspiresilver.pdf"
    Case "bronze"
        mainPDF = "aspirebronze.pdf"
    Case "entry"
        mainPDF = "aspireentry.pdf"
    Case Else
        mainPDF = "aspiretest.pdf"
    End Select
     
    If Len(Dir(ThisWorkbook.Path & "\" & mainPDF)) = 0 Then
        MsgBox ThisWorkbook.Path & "\" & mainPDF, vbCritical, "Missing File - Macro Ending"
        Exit Sub
    End If
     
    MakeFDF mainPDF
End Sub
 
Public Sub MakeFDF(Optional PDF_FILE As String = "aspiretest.pdf")
    Dim sFileHeader As String
    Dim sFileFooter As String
    Dim sFileFields As String
    Dim sFileName As String
    Dim sTmp As String
    Dim lngFileNum As Long
     
     ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
    "%âãÏÓ" & vbCrLf & _
    "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
    "endobj" & vbCrLf & _
    "2 0 obj[" & vbCrLf
     
    sFileFooter = "]" & vbCrLf & _
    "endobj" & vbCrLf & _
    "trailer" & vbCrLf & _
    "<</Root 1 0 R>>" & vbCrLf & _
    "%%EO"
     
    sFileFields = sFileFields & "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(EnikaTitle)/V(EnikaTitle)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Enika)/V(Enika)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoName)/V(CustomerInfoName)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(TM)/V(TM)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(TMTitle)/V(TMTitle)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoAddress)/V(CustomerInfoAddress)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoCity)/V(CustomerInfoCity)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoPostal)/V(CustomerInfoPostal)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoDate1)/V(CustomerInfoDate1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoDate2)/V(CustomerInfoDate2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q1Bonus)/V(Q1Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q1BonusNumber)/V(Q1BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q2Bonus)/V(Q2Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q2BonusNumber)/V(Q2BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q3Bonus)/V(Q3Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q3BonusNumber)/V(Q3BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q4Bonus)/V(Q4Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q4BonusNumber)/V(Q4BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OpeningBalanceDate)/V(OpeningBalanceDate)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate1)/V(OABDate1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OpeningBalance)/V(OpeningBalance)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName1)/V(OABName1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber1)/V(OABNumber1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate2)/V(OABDate2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName2)/V(OABName2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate3)/V(OABDate3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName3)/V(OABName3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber3)/V(OABNumber3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate4)/V(OABDate4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName4)/V(OABName4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber4)/V(OABNumber4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate5)/V(OABDate5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName5)/V(OABName5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber5)/V(OABNumber5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate6)/V(OABDate6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName6)/V(OABName6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber6)/V(OABNumber6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate7)/V(OABDate7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName7)/V(OABName7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber7)/V(OABNumber7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate8)/V(OABDate8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate9)/V(OABDate9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName8)/V(OABName8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber2)/V(OABNumber2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber8)/V(OABNumber8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName9)/V(OABName9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber9)/V(OABNumber9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName10)/V(OABName10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate10)/V(OABDate10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber10)/V(OABNumber10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate11)/V(OABDate11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName11)/V(OABName11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber11)/V(OABNumber11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate12)/V(OABDate12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName12)/V(OABName12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber12)/V(OABNumber12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate13)/V(OABDate13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName13)/V(OABName13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber13)/V(OABNumber13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate14)/V(OABDate14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName14)/V(OABName14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber14)/V(OABNumber14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate15)/V(OABDate15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName15)/V(OABName15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber15)/V(OABNumber15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate16)/V(OABDate16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName16)/V(OABName16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber16)/V(OABNumber16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate17)/V(OABDate17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName17)/V(OABName17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber17)/V(OABNumber17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(AccountBalanceDate)/V(AccountBalanceDate)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(AccountBalance)/V(AccountBalance)>>" & vbCrLf


    sFileFields = Replace(sFileFields, "CustomerInfoBusiness", Range("CustomerInfoBusiness").Value)
    sFileFields = Replace(sFileFields, "EnikaTitle", Range("EnikaTitle").Value)
    sFileFields = Replace(sFileFields, "Enika", Range("Enika").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoName", Range("CustomerInfoName").Value)
    sFileFields = Replace(sFileFields, "TM", Range("TM").Value)
    sFileFields = Replace(sFileFields, "TMTitle", Range("TMTitle").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoAddress", Range("CustomerInfoAddress").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoCity", Range("CustomerInfoCity").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoPostal", Range("CustomerInfoPostal").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate1", Range("CustomerInfoDate1").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate2", Range("CustomerInfoDate2").Value)
    sFileFields = Replace(sFileFields, "Q1Bonus", Range("Q1Bonus").Value)
    sFileFields = Replace(sFileFields, "Q1BonusNumber", Range("Q1BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q2Bonus", Range("Q2Bonus").Value)
    sFileFields = Replace(sFileFields, "Q2BonusNumber", Range("Q2BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q3Bonus", Range("Q3Bonus").Value)
    sFileFields = Replace(sFileFields, "Q3BonusNumber", Range("Q3BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q4Bonus", Range("Q4Bonus").Value)
    sFileFields = Replace(sFileFields, "Q4BonusNumber", Range("Q4BonusNumber").Value)
    sFileFields = Replace(sFileFields, "OpeningBalanceDate", Range("OpeningBalanceDate").Value)
    sFileFields = Replace(sFileFields, "OABDate1", Range("OABDate1").Value)
    sFileFields = Replace(sFileFields, "OpeningBalance", Range("OpeningBalance").Value)
    sFileFields = Replace(sFileFields, "OABName1", Range("OABName1").Value)
    sFileFields = Replace(sFileFields, "OABNumber1", Range("OABNumber1").Value)
    sFileFields = Replace(sFileFields, "OABDate2", Range("OABDate2").Value)
    sFileFields = Replace(sFileFields, "OABName2", Range("OABName2").Value)
    sFileFields = Replace(sFileFields, "OABDate3", Range("OABDate3").Value)
    sFileFields = Replace(sFileFields, "OABName3", Range("OABName3").Value)
    sFileFields = Replace(sFileFields, "OABNumber3", Range("OABNumber3").Value)
    sFileFields = Replace(sFileFields, "OABDate4", Range("OABDate4").Value)
    sFileFields = Replace(sFileFields, "OABName4", Range("OABName4").Value)
    sFileFields = Replace(sFileFields, "OABNumber4", Range("OABNumber4").Value)
    sFileFields = Replace(sFileFields, "OABDate5", Range("OABDate5").Value)
    sFileFields = Replace(sFileFields, "OABName5", Range("OABName5").Value)
    sFileFields = Replace(sFileFields, "OABNumber5", Range("OABNumber5").Value)
    sFileFields = Replace(sFileFields, "OABDate6", Range("OABDate6").Value)
    sFileFields = Replace(sFileFields, "OABName6", Range("OABName6").Value)
    sFileFields = Replace(sFileFields, "OABNumber6", Range("OABNumber6").Value)
    sFileFields = Replace(sFileFields, "OABDate7", Range("OABDate7").Value)
    sFileFields = Replace(sFileFields, "OABName7", Range("OABName7").Value)
    sFileFields = Replace(sFileFields, "OABNumber7", Range("OABNumber7").Value)
    sFileFields = Replace(sFileFields, "OABDate8", Range("OABDate8").Value)
    sFileFields = Replace(sFileFields, "OABDate9", Range("OABDate9").Value)
    sFileFields = Replace(sFileFields, "OABName8", Range("OABName8").Value)
    sFileFields = Replace(sFileFields, "OABNumber2", Range("OABNumber2").Value)
    sFileFields = Replace(sFileFields, "OABNumber8", Range("OABNumber8").Value)
    sFileFields = Replace(sFileFields, "OABName9", Range("OABName9").Value)
    sFileFields = Replace(sFileFields, "OABNumber9", Range("OABNumber9").Value)
    sFileFields = Replace(sFileFields, "OABName10", Range("OABName10").Value)
    sFileFields = Replace(sFileFields, "OABDate10", Range("OABDate10").Value)
    sFileFields = Replace(sFileFields, "OABNumber10", Range("OABNumber10").Value)
    sFileFields = Replace(sFileFields, "OABDate11", Range("OABDate11").Value)
    sFileFields = Replace(sFileFields, "OABName11", Range("OABName11").Value)
    sFileFields = Replace(sFileFields, "OABNumber11", Range("OABNumber11").Value)
    sFileFields = Replace(sFileFields, "OABDate12", Range("OABDate12").Value)
    sFileFields = Replace(sFileFields, "OABName12", Range("OABName12").Value)
    sFileFields = Replace(sFileFields, "OABNumber12", Range("OABNumber12").Value)
    sFileFields = Replace(sFileFields, "OABDate13", Range("OABDate13").Value)
    sFileFields = Replace(sFileFields, "OABName13", Range("OABName13").Value)
    sFileFields = Replace(sFileFields, "OABNumber13", Range("OABNumber13").Value)
    sFileFields = Replace(sFileFields, "OABDate14", Range("OABDate14").Value)
    sFileFields = Replace(sFileFields, "OABName14", Range("OABName14").Value)
    sFileFields = Replace(sFileFields, "OABNumber14", Range("OABNumber14").Value)
    sFileFields = Replace(sFileFields, "OABDate15", Range("OABDate15").Value)
    sFileFields = Replace(sFileFields, "OABName15", Range("OABName15").Value)
    sFileFields = Replace(sFileFields, "OABNumber15", Range("OABNumber15").Value)
    sFileFields = Replace(sFileFields, "OABDate16", Range("OABDate16").Value)
    sFileFields = Replace(sFileFields, "OABName16", Range("OABName16").Value)
    sFileFields = Replace(sFileFields, "OABNumber16", Range("OABNumber16").Value)
    sFileFields = Replace(sFileFields, "OABDate17", Range("OABDate17").Value)
    sFileFields = Replace(sFileFields, "OABName17", Range("OABName17").Value)
    sFileFields = Replace(sFileFields, "OABNumber17", Range("OABNumber17").Value)
    sFileFields = Replace(sFileFields, "AccountBalanceDate", Range("AccountBalanceDate").Value)
    sFileFields = Replace(sFileFields, "AccountBalance", Range("AccountBalance").Value)
     
    sTmp = sFileHeader & sFileFields & sFileFooter
     
     ' Write FDF file to disk
    If Len(Range("CustomerInfoName").Value) Then
        sFileName = Range("CustomerInfoName").Value
    Else: sFileName = "FDF_DEMOTEST"
    End If
    sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
    lngFileNum = FreeFile
    Open sFileName For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
     
     
     ' Open FDF file as PDF
     'Shell "cmd /c " & """" & sFileName & """", vbNormalFocus
     
    Exit Sub
ErrorHandler:
    MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source
End Sub

**Kenneth Hobs** · 10-08-2015, 03:52 PM

Look for a dict object in your fields, I think.

Here is how I modified it to test. The bonus names were missing.

Sub Main()    
  Dim mainPDF As String
     
    Select Case LCase(Worksheets("Statement").Range("I24").Value2)
    Case "platinum"
        mainPDF = "aspiretest.pdf"  '"aspireplatinum.pdf"
    Case "gold"
        mainPDF = "aspiregold.pdf"
    Case "silver"
        mainPDF = "aspiresilver.pdf"
    Case "bronze"
        mainPDF = "aspirebronze.pdf"
    Case "entry"
        mainPDF = "aspireentry.pdf"
    Case Else
        mainPDF = "aspiretest.pdf"
    End Select
     
    If Len(Dir(ThisWorkbook.Path & "\" & mainPDF)) = 0 Then
        MsgBox ThisWorkbook.Path & "\" & mainPDF, vbCritical, "Missing File - Macro Ending"
        Exit Sub
    End If
     
    MakeFDF mainPDF
End Sub
 
Public Sub MakeFDF(Optional PDF_FILE As String = "aspiretest.pdf")
    Dim sFileHeader As String
    Dim sFileFooter As String
    Dim sFileFields As String
    Dim sFileName As String
    Dim sTmp As String
    Dim lngFileNum As Long
     
     ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
    "%âãÏÓ" & vbCrLf & _
    "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
    "endobj" & vbCrLf & _
    "2 0 obj[" & vbCrLf
     
    sFileFooter = "]" & vbCrLf & _
    "endobj" & vbCrLf & _
    "trailer" & vbCrLf & _
    "<</Root 1 0 R>>" & vbCrLf & _
    "%%EO"
     
    sFileFields = sFileFields & "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(EnikaTitle)/V(EnikaTitle)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Enika)/V(Enika)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoName)/V(CustomerInfoName)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(TM)/V(TM)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(TMTitle)/V(TMTitle)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoAddress)/V(CustomerInfoAddress)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoCity)/V(CustomerInfoCity)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoPostal)/V(CustomerInfoPostal)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoDate1)/V(CustomerInfoDate1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(CustomerInfoDate2)/V(CustomerInfoDate2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q1Bonus)/V(Q1Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q1BonusNumber)/V(Q1BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q2Bonus)/V(Q2Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q2BonusNumber)/V(Q2BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q3Bonus)/V(Q3Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q3BonusNumber)/V(Q3BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q4Bonus)/V(Q4Bonus)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(Q4BonusNumber)/V(Q4BonusNumber)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OpeningBalanceDate)/V(OpeningBalanceDate)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate1)/V(OABDate1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OpeningBalance)/V(OpeningBalance)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName1)/V(OABName1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber1)/V(OABNumber1)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate2)/V(OABDate2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName2)/V(OABName2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate3)/V(OABDate3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName3)/V(OABName3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber3)/V(OABNumber3)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate4)/V(OABDate4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName4)/V(OABName4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber4)/V(OABNumber4)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate5)/V(OABDate5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName5)/V(OABName5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber5)/V(OABNumber5)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate6)/V(OABDate6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName6)/V(OABName6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber6)/V(OABNumber6)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate7)/V(OABDate7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName7)/V(OABName7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber7)/V(OABNumber7)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate8)/V(OABDate8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate9)/V(OABDate9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName8)/V(OABName8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber2)/V(OABNumber2)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber8)/V(OABNumber8)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName9)/V(OABName9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber9)/V(OABNumber9)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName10)/V(OABName10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate10)/V(OABDate10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber10)/V(OABNumber10)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate11)/V(OABDate11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName11)/V(OABName11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber11)/V(OABNumber11)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate12)/V(OABDate12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName12)/V(OABName12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber12)/V(OABNumber12)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate13)/V(OABDate13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName13)/V(OABName13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber13)/V(OABNumber13)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate14)/V(OABDate14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName14)/V(OABName14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber14)/V(OABNumber14)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate15)/V(OABDate15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName15)/V(OABName15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber15)/V(OABNumber15)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate16)/V(OABDate16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName16)/V(OABName16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber16)/V(OABNumber16)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABDate17)/V(OABDate17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABName17)/V(OABName17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(OABNumber17)/V(OABNumber17)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(AccountBalanceDate)/V(AccountBalanceDate)>>" & vbCrLf
    sFileFields = sFileFields & "<</T(AccountBalance)/V(AccountBalance)>>" & vbCrLf


    sFileFields = Replace(sFileFields, "CustomerInfoBusiness", Range("CustomerInfoBusiness").Value)
    sFileFields = Replace(sFileFields, "EnikaTitle", Range("EnikaTitle").Value)
    sFileFields = Replace(sFileFields, "Enika", Range("Enika").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoName", Range("CustomerInfoName").Value)
    sFileFields = Replace(sFileFields, "TM", Range("TM").Value)
    sFileFields = Replace(sFileFields, "TMTitle", Range("TMTitle").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoAddress", Range("CustomerInfoAddress").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoCity", Range("CustomerInfoCity").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoPostal", Range("CustomerInfoPostal").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate1", Range("CustomerInfoDate1").Value)
    sFileFields = Replace(sFileFields, "CustomerInfoDate2", Range("CustomerInfoDate2").Value)
    sFileFields = Replace(sFileFields, "Q1Bonus", Range("Q1Bonus").Value)
   ' sFileFields = Replace(sFileFields, "Q1BonusNumber", Range("Q1BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q2Bonus", Range("Q2Bonus").Value)
    'sFileFields = Replace(sFileFields, "Q2BonusNumber", Range("Q2BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q3Bonus", Range("Q3Bonus").Value)
    'sFileFields = Replace(sFileFields, "Q3BonusNumber", Range("Q3BonusNumber").Value)
    sFileFields = Replace(sFileFields, "Q4Bonus", Range("Q4Bonus").Value)
    'sFileFields = Replace(sFileFields, "Q4BonusNumber", Range("Q4BonusNumber").Value)
    sFileFields = Replace(sFileFields, "OpeningBalanceDate", Range("OpeningBalanceDate").Value)
    sFileFields = Replace(sFileFields, "OABDate1", Range("OABDate1").Value)
    sFileFields = Replace(sFileFields, "OpeningBalance", Range("OpeningBalance").Value)
    sFileFields = Replace(sFileFields, "OABName1", Range("OABName1").Value)
    sFileFields = Replace(sFileFields, "OABNumber1", Range("OABNumber1").Value)
    sFileFields = Replace(sFileFields, "OABDate2", Range("OABDate2").Value)
    sFileFields = Replace(sFileFields, "OABName2", Range("OABName2").Value)
    sFileFields = Replace(sFileFields, "OABDate3", Range("OABDate3").Value)
    sFileFields = Replace(sFileFields, "OABName3", Range("OABName3").Value)
    sFileFields = Replace(sFileFields, "OABNumber3", Range("OABNumber3").Value)
    sFileFields = Replace(sFileFields, "OABDate4", Range("OABDate4").Value)
    sFileFields = Replace(sFileFields, "OABName4", Range("OABName4").Value)
    sFileFields = Replace(sFileFields, "OABNumber4", Range("OABNumber4").Value)
    sFileFields = Replace(sFileFields, "OABDate5", Range("OABDate5").Value)
    sFileFields = Replace(sFileFields, "OABName5", Range("OABName5").Value)
    sFileFields = Replace(sFileFields, "OABNumber5", Range("OABNumber5").Value)
    sFileFields = Replace(sFileFields, "OABDate6", Range("OABDate6").Value)
    sFileFields = Replace(sFileFields, "OABName6", Range("OABName6").Value)
    sFileFields = Replace(sFileFields, "OABNumber6", Range("OABNumber6").Value)
    sFileFields = Replace(sFileFields, "OABDate7", Range("OABDate7").Value)
    sFileFields = Replace(sFileFields, "OABName7", Range("OABName7").Value)
    sFileFields = Replace(sFileFields, "OABNumber7", Range("OABNumber7").Value)
    sFileFields = Replace(sFileFields, "OABDate8", Range("OABDate8").Value)
    sFileFields = Replace(sFileFields, "OABDate9", Range("OABDate9").Value)
    sFileFields = Replace(sFileFields, "OABName8", Range("OABName8").Value)
    sFileFields = Replace(sFileFields, "OABNumber2", Range("OABNumber2").Value)
    sFileFields = Replace(sFileFields, "OABNumber8", Range("OABNumber8").Value)
    sFileFields = Replace(sFileFields, "OABName9", Range("OABName9").Value)
    sFileFields = Replace(sFileFields, "OABNumber9", Range("OABNumber9").Value)
    sFileFields = Replace(sFileFields, "OABName10", Range("OABName10").Value)
    sFileFields = Replace(sFileFields, "OABDate10", Range("OABDate10").Value)
    sFileFields = Replace(sFileFields, "OABNumber10", Range("OABNumber10").Value)
    sFileFields = Replace(sFileFields, "OABDate11", Range("OABDate11").Value)
    sFileFields = Replace(sFileFields, "OABName11", Range("OABName11").Value)
    sFileFields = Replace(sFileFields, "OABNumber11", Range("OABNumber11").Value)
    sFileFields = Replace(sFileFields, "OABDate12", Range("OABDate12").Value)
    sFileFields = Replace(sFileFields, "OABName12", Range("OABName12").Value)
    sFileFields = Replace(sFileFields, "OABNumber12", Range("OABNumber12").Value)
    sFileFields = Replace(sFileFields, "OABDate13", Range("OABDate13").Value)
    sFileFields = Replace(sFileFields, "OABName13", Range("OABName13").Value)
    sFileFields = Replace(sFileFields, "OABNumber13", Range("OABNumber13").Value)
    sFileFields = Replace(sFileFields, "OABDate14", Range("OABDate14").Value)
    sFileFields = Replace(sFileFields, "OABName14", Range("OABName14").Value)
    sFileFields = Replace(sFileFields, "OABNumber14", Range("OABNumber14").Value)
    sFileFields = Replace(sFileFields, "OABDate15", Range("OABDate15").Value)
    sFileFields = Replace(sFileFields, "OABName15", Range("OABName15").Value)
    sFileFields = Replace(sFileFields, "OABNumber15", Range("OABNumber15").Value)
    sFileFields = Replace(sFileFields, "OABDate16", Range("OABDate16").Value)
    sFileFields = Replace(sFileFields, "OABName16", Range("OABName16").Value)
    sFileFields = Replace(sFileFields, "OABNumber16", Range("OABNumber16").Value)
    sFileFields = Replace(sFileFields, "OABDate17", Range("OABDate17").Value)
    sFileFields = Replace(sFileFields, "OABName17", Range("OABName17").Value)
    sFileFields = Replace(sFileFields, "OABNumber17", Range("OABNumber17").Value)
    sFileFields = Replace(sFileFields, "AccountBalanceDate", Range("AccountBalanceDate").Value)
    sFileFields = Replace(sFileFields, "AccountBalance", Range("AccountBalance").Value)
     
    sTmp = sFileHeader & sFileFields & sFileFooter
     
     ' Write FDF file to disk
    If Len(Range("CustomerInfoName").Value) Then
        sFileName = Range("CustomerInfoName").Value
    Else: sFileName = "FDF_DEMOTEST"
    End If
    sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
    lngFileNum = FreeFile
    Open sFileName For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
     
     
     ' Open FDF file as PDF
     Shell "cmd /c " & """" & sFileName & """", vbNormalFocus
     
    Exit Sub
ErrorHandler:
    MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source
End Sub

**DarinM** · 10-09-2015, 06:27 AM

Hi Ken,

good on you, you found those.. I was trying hard to not miss any haha.

After that, it does open up, but like you said it's asking for a dict object. What could that be? Would that be a sort of formatting in the excel that Acrobat does not like?

I am googling the error with not much success. I've tried making everything a number, taking out negatives, erasing formulas and replacing the values...nothing yet.

any idea?

thx - Darin

edit - exhausted google...no answer

hope you can help Ken

**DarinM** · 10-09-2015, 07:59 AM

will it import a blank cell, or does there have to be something in all the cells that are called upon??

i.e if OABName17 is blank, will that cause an error?

if so, i'll need to find a workaround because there will be lots of blanks in 1 statement, but full in another...

--

edit,

i populated all the fields and the error went away, except it did not populate ANY fields.

now what :| haha this is tricky...

also, my cmd.exe window is up while i am doing this, is that normal ?? it never used to be up

**Kenneth Hobs** · 10-09-2015, 08:11 AM

There are several things that can cause it I think. Google: FDF Adobe Acrobat Expected a dict object

The main cause may be an empty value. Try that test on your smaller file. You might have to see if the value is "" in the code and if so, set the value in the Replace() to to say vbNullString, vbNull, or maybe " ".

Special characters might cause the problem too or maybe things like ()'s or quote characters. Those have to be escaped somehow I suspect.

Edit: I see that you found the blank value issue. Yes, Cmd's shell window was set to show as vbNormalFocus. You can set that option as vbHide. I just skipped the ShellExecute(). Comment out that line or replaced with the ShellExecute() if you wanted to show the FDF.

**DarinM** · 10-09-2015, 08:23 AM

Hmm... so I can run the macro now, but it doesn't populate, and doesn't give error. Now what would screw that up? Any ideas on that one??

edit: i did the vBHide and it didnt show cmd.exe thanks, but forms are still blank

edit #2: does it run for you Ken?

**Kenneth Hobs** · 10-09-2015, 10:14 AM

I suspect that it is blank because your FDF built fieldnames are not exactly the same as the PDF form's textbox fieldnames. Remember, those fieldnames are case sensitive.

I modified my code for your short file. Even with all field values missing, I did not see the dict error. I recommend using that approach for your bigger pdf file.

Since you have Adobe Acrobat, this link would likely interest you. http://www.myengineeringworld.net/20...excel-vba.html

Sub Main()    
  Dim mainPDF As String, aNames() As String, s As String
    Dim c As Range, sFilename As String
    
    'Build array of Names for FDF file from current workbook of Names to insert
    'Note: Adobe Acrobat form's text field names are case sensitive.  Excel Named ranges are not.
    s = "name,address,city,postal,opening,month,balance"
    aNames() = Split(s, ",")
    s = MissingNames(aNames())
    If s <> "" Then
      MsgBox s, vbCritical, "Missing Names - Macro Ending"
      Exit Sub
    End If
     
    'Creat the pdf form file's name with fields to fill
    Select Case LCase(Worksheets("Sheet1").Range("A2").Value2)
    Case "gold"
        mainPDF = "csGold.pdf"
    Case "silver"
        mainPDF = "csSilver.pdf"
    Case Else
        mainPDF = "cstest.pdf"
    End Select
    s = ThisWorkbook.Path & "\" & mainPDF
    If Len(Dir(s)) = 0 Then
        MsgBox s, vbCritical, "Missing File - Macro Ending"
        Exit Sub
    End If
    
    'Create the FDFfilename, sFilename
    If Len(Range("Account").Value) Then
        sFilename = Range("Account").Value
    Else: sFilename = "FDF_DEMOTEST"
    End If
    sFilename = ActiveWorkbook.Path & "\" & sFilename & ".fdf"
     
    MakeFDF2 aNames(), mainPDF, sFilename
    ' Open FDF file as PDF
     Shell "cmd /c " & """" & sFilename & """", vbHide
End Sub


Function MissingNames(sNames() As String) As String
  Dim c As Range, v As Variant, s As String
  For Each v In sNames()
    Set c = Nothing
    On Error Resume Next
    Set c = Range(v)
    If c Is Nothing Then s = s & v & vbCrLf
  Next v
  MissingNames = s
End Function
 
Public Sub MakeFDF2(sNames() As String, Optional PDF_FILE As String = "cstest.pdf", _
  Optional fdfFilename As String = "FDF_DEMOTEST")
    Dim sFileHeader As String, sFileFooter As String, sFileFields As String
    Dim sFilename As String, sTmp As String, lngFileNum As Long
    Dim v As Variant, i As Long
     
     ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
                  "%âãÏÓ" & vbCrLf & _
                  "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "2 0 obj[" & vbCrLf
                                   
   sFileFooter = "]" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "trailer" & vbCrLf & _
                  "<</Root 1 0 R>>" & vbCrLf & _
                  "%%EO"
     
    For i = LBound(sNames) To UBound(sNames)
       sNames(i) = "<</T(" & sNames(i) & ")/V(" & Range(sNames(i)).Value & ")>>"
    Next i
    sFileFields = Join(sNames, vbCrLf) & vbCrLf
    'Debug.Print sFileFields
    
    sTmp = sFileHeader & sFileFields & sFileFooter
    
    If Len(Dir(fdfFilename)) <> 0 Then Kill fdfFilename
    lngFileNum = FreeFile
    Open fdfFilename For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
     
    Exit Sub
ErrorHandler:
    MsgBox "MakeFDF Error: " + str(Err.Number) + " " + Err.Description + " " + Err.Source
End Sub

**DarinM** · 10-09-2015, 10:33 AM

I copy/pasted every single form, so not sure if that is the case, but maybe I will re-build it and check it along the way.

As for your solution...I don't know how to build an array, so that is why I am doing it long-hand.

I'll rebuild and try slowly. I was hoping for copy/paste-ing of the sFields to work, but there is an error I guess.

thanks

**Kenneth Hobs** · 10-09-2015, 10:51 AM

Sure, that is easy. Just replace the value of s with the output in the immediate window from the excelhero routine to get fieldnames. Split the value for easy reading in your code by adding the & concatenation operator and _ line continuation character. If it is really long, just do an s = s & "other strings concatenated...".

My MissingNames() routine called in Main() will catch and show you any like named Excel Names that are well, missing.
e.g.

s = "AccountBalance,AccountBalanceDate,CustomerInfoAddress,CustomerInfoBusiness,CustomerInfoCity,CustomerInfoDate1," & _
      "CustomerInfoDate2,CustomerInfoName,CustomerInfoPostal,Enika,EnikaTitle,OABDate1,OABDate10,OABDate11,OABDate12,OABDate13," & _
      "OABDate14,OABDate15,OABDate16,OABDate17,OABDate2,OABDate3,OABDate4,OABDate5,OABDate6,OABDate7,OABDate8,OABDate9,OABName1," & _
      "OABName10,OABName11,OABName12,OABName13,OABName14,OABName15,OABName16,OABName17,OABName2,OABName3,OABName4,OABName5," & _
      "OABName6,OABName7,OABName8,OABName9,OABNumber1,OABNumber10,OABNumber11,OABNumber12,OABNumber13,OABNumber14,OABNumber15," & _
      "OABNumber16,OABNumber17,OABNumber2,OABNumber3,OABNumber4,OABNumber5,OABNumber6,OABNumber7,OABNumber8,OABNumber9," & _
      "OpeningBalance,OpeningBalanceDate,Q1Bonus,Q1BonusNumber,Q2Bonus,Q2BonusNumber,Q3Bonus,Q3BonusNumber,Q4Bonus,Q4BonusNumber,TM,TMTitle"

Public Sub ListPDF_Fields()             
    Dim AcroExchAVDoc As CAcroAVDoc
    Dim AcroExchApp As CAcroApp
    Dim AFORMAUT As AFORMAUTLib.AFormApp
    Dim FormField As AFORMAUTLib.Field
    Dim FormFields As AFORMAUTLib.Fields
    Dim bOK As Boolean
    Dim sFields As String
    Dim sTypes As String
    Dim sFieldName As String
                             
    ' For this procedure to work, computer must have a full version
    ' of Adobe Acrobat installed. Also, a reference to the following
    ' Type Libraries must be made:
    '     AFormAut 1.0
    '     Adobe Acrobat 7.0 (or newer)
    
    On Error GoTo ErrorHandler
    
    Set AcroExchApp = CreateObject("AcroExch.App")
    Set AcroExchAVDoc = CreateObject("AcroExch.AVDoc")
'*************************************Add path in first parameter below: ***********************************
    bOK = AcroExchAVDoc.Open("C:\Users\130103\Dropbox\Excel\pdf\FDFNames\aspiretest.pdf", "")
    AcroExchAVDoc.BringToFront
    AcroExchApp.Hide
    
    If (bOK) Then
        Set AFORMAUT = CreateObject("AFormAut.App")
        Set FormFields = AFORMAUT.Fields
        For Each FormField In FormFields
            With FormField
                sFieldName = .Name
                If .IsTerminal Then
                    If sFields = "" Then
                        sFields = .Name
                        sTypes = .Type
                    Else
                        sFields = sFields + "," + .Name
                        sTypes = sTypes + "," + .Type
                    End If
                End If
            End With
        Next FormField
        AcroExchAVDoc.Close True
    End If
    Debug.Print sFields
    Debug.Print sTypes
   
    Set AcroExchAVDoc = Nothing
    Set AcroExchApp = Nothing
    Set AFORMAUT = Nothing
    Set Field = Nothing
    Exit Sub
         
ErrorHandler:
    MsgBox "FieldList Error: " + str(Err.Number) + " " + Err.Description + " " + Err.Source
    
End Sub

**DarinM** · 10-09-2015, 10:56 AM

Ok weird.

I deleted all fields except 1, and tried it, and even the code for this did not populate the 1 form.

does it work for you? this is weird.

Option Explicit 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Sub Main()
    Dim mainPDF As String
     
    Select Case LCase(Worksheets("Statement").Range("I24").Value2)
    Case "platinum"
        mainPDF = "aspireplatinum.pdf"
    Case "gold"
        mainPDF = "aspiregold.pdf"
    Case "silver"
        mainPDF = "aspiresilver.pdf"
    Case "bronze"
        mainPDF = "aspirebronze.pdf"
    Case "entry"
        mainPDF = "aspireentry.pdf"
    Case Else
        mainPDF = "aspiretest.pdf"
    End Select
     
    If Len(Dir(ThisWorkbook.Path & "\" & mainPDF)) = 0 Then
        MsgBox ThisWorkbook.Path & "\" & mainPDF, vbCritical, "Missing File - Macro Ending"
        Exit Sub
    End If
     
    MakeFDF mainPDF
End Sub
 
Public Sub MakeFDF(Optional PDF_FILE As String = "aspiretest.pdf")
    Dim sFileHeader As String
    Dim sFileFooter As String
    Dim sFileFields As String
    Dim sFileName As String
    Dim sTmp As String
    Dim lngFileNum As Long
     
     ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
     
    sFileHeader = "%FDF-1.2" & vbCrLf & _
    "%âãÏÓ" & vbCrLf & _
    "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
    "endobj" & vbCrLf & _
    "2 0 obj[" & vbCrLf
     
    sFileFooter = "]" & vbCrLf & _
    "endobj" & vbCrLf & _
    "trailer" & vbCrLf & _
    "<</Root 1 0 R>>" & vbCrLf & _
    "%%EO"
     
    sFileFields = sFileFields & "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf


     
    sFileFields = Replace(sFileFields, "CustomerInfoBusiness", Range("CustomerInfoBusiness").Value)
   
     
    sTmp = sFileHeader & sFileFields & sFileFooter
     
     ' Write FDF file to disk
    If Len(Range("CustomerInfoName").Value) Then
        sFileName = Range("CustomerInfoName").Value
    Else: sFileName = "FDF_DEMOTEST"
    End If
    sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
    lngFileNum = FreeFile
    Open sFileName For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
     
     
     ' Open FDF file as PDF
    Shell "cmd /c " & """" & sFileName & """", vbHide
     
    Exit Sub
ErrorHandler:
    MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source
End Sub

**Kenneth Hobs** · 10-09-2015, 11:20 AM

Your Replace() replaced the PDF Fieldname and replaced it with the value of the named range. Replace() is not really needed.

  'sFileFields = sFileFields & "<</T(CustomerInfoBusiness)/V(CustomerInfoBusiness)>>" & vbCrLf  
  'sFileFields = Replace(sFileFields, "CustomerInfoBusiness", Range("CustomerInfoBusiness").Value)
  sFileFields = sFileFields & "<</T(CustomerInfoBusiness)/V(" & Range("CustomerInfoBusiness").Value & ")>>" & vbCrLf

**DarinM** · 10-09-2015, 11:37 AM

that one worked for my test, I will try it going slowly forward now.

yay!

thanks for helping me today.

just tried 6 cells in a row.

I think your last edit about me replacing screwed it all up.

i'm excited! ill update either late today before i leave work or tuesday sometimes (monday is our thanksgiving in Canada)

Thread: Excel Export Cells to PDF Forms (fillable)

Thread Tools

Display

Posting Permissions