PDA

View Full Version : Excel Export Cells to PDF Forms (fillable)



DarinM
10-01-2015, 06:15 AM
Hi all,

I have done some googling and found a way you can import data from an excel file to PDF, however, it needs to be in columns, not specific cells.

I was hoping somebody would be able to tell/show me a way to import data into the PDF from specific excel cells.

I currently have 'statements' being made from a bunch of different spreadsheets via a macro/module, and I did not make it, so it looks really confusing. The information is then pulled from all spreadsheets into 1 spreadsheet and into various cells, not into columns like the PDF import likes.

p.s. I am trying to reorganize the macro into columns, but I am getting stuck with a bunch of the ifstatements, not every customer has 10 lines of sales, so it could be 1 column or 10 columns depending on if they are new/old (10 months as an example vs 1 month).

thanks for your time

Kenneth Hobs
10-01-2015, 06:42 AM
If it is a form then you only have a set number of Fields that you can fill.

I guess you have probably seen the example in the link at the end. Just adapt it to your needs. That macro uses columns (fields) and rows (records). So, if you are just creating a one-off fill, you can fill the fields from any cell that you like. I would recommend Naming your cells in that case to make filling the form easier.

http://www.excelhero.com/blog/2010/04/excel-acrobat-pdf-form-filler.html

DarinM
10-01-2015, 07:03 AM
Thanks Ken,

question, I have opened it up, and I do see the "---NAME---" portion, but i don't see the cells being named that, and I don't see where it says "b5" or column B.

My spreadsheet statement that I want converted is say

A5 Name
A6 City
B6 Province
C7 Postal Code

so they are quite scattered, not in a nice column.

would I be able to say, name those cells ---Name--- , ---City---- etc, and just replace this line with mine? I don't see how that would work (so A5 would be ----Name--- instead of A5) ?? Then would the macro find ---Name--- wherever it is, either a5 or Z10?

sFileFields = Replace(sFileFields, "---CONTACT---", vClient(1, 9))

Kenneth Hobs
10-01-2015, 07:17 AM
I guess you know that it is very easy to name cells. In the top left Name Box, left of the formula bar, enter say Name, and press Enter key. Then,

sFileFields = Replace(sFileFields, "---CONTACT---", Range("Name").Value)
'or
'sFileFields = Replace(sFileFields, "---CONTACT---", Worksheets("Sheet1").Range("A5").Value)
I think that the name method is easier for coding purposes though.

DarinM
10-01-2015, 08:58 AM
working slowly on this, however I think I would prefer the sFileFields = Replace(sFileFields, "---CONTACT---", Worksheets("Sheet1")Range("A5").Value code.

howver, when I put that it, it says "Compile Error: Expect: list separator or )

Kenneth Hobs
10-01-2015, 09:29 AM
A period and a closing parentheses was missing.
e.g.

Sub ken()
Dim sFileFields As String
Worksheets("Sheet1").Range("A5").Value = "Kenneth Hobson" 'CONTACT
sFileFields = "As a valued customer " & "---CONTACT---" & ", we hope that we have been helpful."
sFileFields = Replace(sFileFields, "---CONTACT---", Worksheets("Sheet1").Range("A5").Value)
MsgBox sFileFields
End Sub

DarinM
10-01-2015, 09:36 AM
Thanks Ken,

for testing before you replied, I kept going with the named cell approach.

I have tried my own statement in a new excel, copied the code from the example, and I am running into an issue now. "13 Type mismatch VBAProject".

I also have some concerns about a part in the code, i'll try and highlight for you.

I uploaded the files, the pdf is super simple for testing, looks like I can't upload that, but you can trust it is done correctly (field names are in the code).

As for my concern, I don't have a Len(VClient(1,1) .. that was from the original excel, I would like that to be pointed to cell named "Account"

' Write FDF file to disk If Len(vClient(1, 1)) Then sFileName = vClient(1, 1) Else sFileName = "FDF_DEMOTEST"
sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
lngFileNum = FreeFile
Open sFileName For Output As lngFileNum
Print #lngFileNum, sTmp
Close #lngFileNum
DoEvents

but before we tackle that, I guess i'd like to see the script run!

Hope you can help, sorry if this is becoming a bigger project than what you wish to assist with....thanks Ken!

Kenneth Hobs
10-01-2015, 10:07 AM
I will look into this more, it is not a problem, it is what we do here.

Offhand, it would be:

If Len(Range("Account").Value) Then
sFileName = Range("Account").Value
Else: sFileName = "FDF_DEMOTEST"
End If

DarinM
10-01-2015, 10:12 AM
Great thanks, and ahh, I deleted the Len part and put in just the Range... i was close!.

I await your response :)

Kenneth Hobs
10-01-2015, 11:05 AM
I had to create a named range for Opening and set a value for Account named range. Of course I did not have the cstest.pdf file to test with using those fieldnames.


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
Private Const SW_NORMAL = 1
Public Const PDF_FILE = "cstest.pdf"

Public Sub MakeFDF()
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 = "<</T(name)/V(---NAME---)>>" & 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, "---NAME---", Range("Name").Value)
sFileFields = Replace(sFileFields, "---ADDRESS---", Range("Address").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


' Write FDF file to disk
If Len(Range("Account").Value) Then
sFileName = Range("Account").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
ShellExecute vbNull, "open", sFileName, vbNull, vbNull, SW_NORMAL
Exit Sub


ErrorHandler:
MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source


End Sub

DarinM
10-01-2015, 11:14 AM
Thanks Ken.

I just did a copy paste of that code and it came back with "MakeFDF Error: 1004 Method 'Range' of object '_Global' failed VBAProject.

I searched global in the code, didn't come up with anything. ideas?

I uploaded the pdf here, it's super simple for testing.

http://speedy.sh/Zj3FX/cstest.pdf

Kenneth Hobs
10-01-2015, 12:43 PM
I could not download due to company restrictions. You can always zip one or more files and attach if size is small enough. Otherwise, dropbox.com or such can sometimes be used. I can look at it tonight at home.

This should be close.

DarinM
10-01-2015, 01:03 PM
Hi Ken,

It opens, but doesn't populate the PDF...so at least it opens! haha.

didn't know you could zip here, i would of done that originally, oops!

i changed the ---name--- to just name, and that also did not work. (not sure if that matters here?)


sFileFields = "<</T(name)/V(name)>>" & 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

I noticed it did not generate an .FDF file in my file location as I think it is supposed to?

Kenneth Hobs
10-01-2015, 04:51 PM
This seems ok. I changed it just a bit. Of course one might want to edit it more to pass certain parts as input parameter values.

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


Public Sub MakeFDF()
Dim sFileHeader As String
Dim sFileFooter As String
Dim sFileFields As String
Dim sFileName As String
Dim sTmp As String
Dim lngFileNum As Long
Dim PDF_FILE, SW_NORMAL As Integer

SW_NORMAL = 1
PDF_FILE = "cstest.pdf"

' 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(name)/V(---NAME---)>>" & 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, "---NAME---", Range("Name").Value)
sFileFields = Replace(sFileFields, "---ADDRESS---", Range("Address").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


' Write FDF file to disk
If Len(Range("Account").Value) Then
sFileName = Range("Account").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

Debug.Print sFileName
' Open FDF file as PDF
ShellExecute vbNull, "open", sFileName, vbNull, vbNull, SW_NORMAL
'Shell "cmd /c " & """" & sFileName & """", vbNormalFocus

Exit Sub


ErrorHandler:
MsgBox "MakeFDF Error: " + str(Err.Number) + " " + Err.Description + " " + Err.Source


End Sub

DarinM
10-02-2015, 12:15 PM
Weird, I copied that code, hit run, it opened my PDF but did not fill it, then I tried it again, and it said an error 70 of permissions, now I try it again and it says 1004 Method Range of object _global failed VBA Project.

I am confused :| how does that happen?

even when it ran though, it did not populate. did the pdf populate for you Ken?

Kenneth Hobs
10-02-2015, 01:52 PM
When you open it, there is probably a box near the top to enable the fill. Maybe there is an option in your PDF read program to allow those. It probably depends on which one you are using. Check closely when it opens....

DarinM
10-05-2015, 05:52 AM
Hi Ken,

still getting an error in Excel when I click on button 1 with the new code. if you aren't getting the error, then what could it be on my end?

1004 Method 'Range' of object '_Global' failed VBAProject


---------

edit! I just looked online quick on what that means, and i noticed I had a line called "Opening" but no cell had the name "Opening" , deleted it, and it worked.


thanks!

I'll start editing more fields and will come back here if I have an issue.

appreciate it!


------

double edit!

I did notice top right it said 'options' ... 'trust this document once or always'...

thanks Ken .. I was too excited and missed that :)

Kenneth Hobs
10-05-2015, 06:00 AM
Sorry, I forgot that I had added a named range to take care of that missing one. I had meant to explain that in the "changed it a bit".

DarinM
10-05-2015, 06:12 AM
No Problem. :)!

Curious, i am trying to get a bit more fancy now (human nature).

we have different levels of loyalty program, and I was hoping that at each level, it could open up a different template (cstest.pdf) ... is that possible?

if cell 1 = gold = csgold.pdf, if cell 1 = silver = cssilver.pdf.

or is it just one size fits all?

Kenneth Hobs
10-05-2015, 07:09 AM
Sure, no problem at all. Did you see how I moved the PDF_File into the Sub? You can just as easily input it into your Sub as an Input parameter.

For more advanced calls, you can add more input parameters such as an array of Names and modify the code to iterate the Names.

For the one input parameter case:

Sub Main()
Dim mainPDF As String

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

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 = "cstest.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 = "<</T(name)/V(---NAME---)>>" & 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, "---NAME---", Range("Name").Value)
sFileFields = Replace(sFileFields, "---ADDRESS---", Range("Address").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

' Write FDF file to disk
If Len(Range("Account").Value) Then
sFileName = Range("Account").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-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/2013/10/read-and-write-pdf-forms-from-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,OABD ate1,OABDate10,OABDate11,OABDate12,OABDate13," & _
"OABDate14,OABDate15,OABDate16,OABDate17,OABDate2,OABDate3,OABDate4,OABDate5 ,OABDate6,OABDate7,OABDate8,OABDate9,OABName1," & _
"OABName10,OABName11,OABName12,OABName13,OABName14,OABName15,OABName16,OABNa me17,OABName2,OABName3,OABName4,OABName5," & _
"OABName6,OABName7,OABName8,OABName9,OABNumber1,OABNumber10,OABNumber11,OABN umber12,OABNumber13,OABNumber14,OABNumber15," & _
"OABNumber16,OABNumber17,OABNumber2,OABNumber3,OABNumber4,OABNumber5,OABNumb er6,OABNumber7,OABNumber8,OABNumber9," & _
"OpeningBalance,OpeningBalanceDate,Q1Bonus,Q1BonusNumber,Q2Bonus,Q2BonusNumb er,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) :)