我导出了一个带有FDF表单字段的PDF,并编写了一个sub来逐字输出另一个FDF,其中包含表单字段值的单元格值。如果我在文本编辑器中编辑 FDF 并更改值,Acrobat 可以很好地读取文件,但带有 VBA 的文件输出会引发错误:
我尝试了Adobe 无法打开 whatever.fdf,因为它不是受支持的文件类型,或者因为文件已损坏
两种不同类型的换行符,我尝试了具有 xfdf 格式的类似子,它与相同的结果略有不同。
Sub something()
Dim sht As Worksheet
Set sht = Sheets("owssvr")
Dim lastrow As Integer
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object
Dim x As Integer
For x = 2 To lastrow
Set Fileout = fso.CreateTextFile("C:Usersblabla" & x & ".fdf", True, True)
Fileout.Write "%FDF-1.2" & vbCrLf & _
"%âãÏÓ" & vbCrLf & _
"1 0 obj" & vbCrLf & _
"<</FDF<</F(MyDocument.pdf)/Fields[<</T(Adobe Form Field)/V(" & sht.Range("U" & x) & ")>>]/ID[<4ED54800AC4A3D41ABE4F4C7B12A3D23><609E705B7532334B8F914CFF4C09F2A0>]/UF(MyDocument.pdf)>>/Type/Catalog>>" & vbCrLf & _
"endobj" & vbCrLf & _
"trailer" & vbCrLf & _
"<</Root 1 0 R>>" & vbCrLf & _
"%%EOF" & vbCrLf
Fileout.Close
Next x
End Sub
只需省略行:"%âãÏÓ"&vbCrLf & _"。/ID 和/UF 键不是真正需要的。
这样的事情应该有效:
Fileout.Write "%FDF-1.2" & vbCrLf & _
"1 0 obj<</FDF<<" & vbCrLf & _
"/F(MyDocument.pdf)" & vbCrLf & _
"/Fields" & vbCrLf & _
"[<</T(Adobe Form Field)/V(xyValue)>>]" & vbCrLf & _
">>>>" & vbCrLf & _
"endobj" & vbCrLf & _
"trailer" & vbCrLf & _
"<</Root 1 0 R>>" & vbCrLf & _
"%%EOF" & vbCrLf
您可以在 Acrobat IAC 文档中找到它。这里有一个快速的vbs(vba(示例。你只需要 2 行:jso.getField 和 f.value =...祝你好运。
'//-> Set a value for a form field via JSO
'//-> Settings
FileNm = "d:TestInput.pdf"
FieldNm= "Input1"
FieldValue= "50"
'//-> let's start
Set App = CreateObject("Acroexch.app")
app.show
Set AVDoc = CreateObject("AcroExch.AVDoc")
'//-> open the file and put the value in
If AVDoc.Open(FileNM,"") Then
Set PDDoc = AVDoc.GetPDDoc()
Set jso = PDDoc.GetJSObject
'//-> Get the field and put a value in
set f = jso.getField(FieldNm)
f.value = FieldValue
end if
尽管我想保持开放状态,希望有人弄清楚为什么 VBA 会搞砸 unicode,但我的问题可以在不调用 fso 的情况下解决,只需在原始 FDF 上使用 FreeFile 和字符串替换
Sub blabla()
Dim objAcroApp As Acrobat.AcroApp
Dim objAcroAVDoc As Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim jsObj As Object
Dim boResult As Boolean
Dim oldPDF As String
Dim NewFilePath As String
Dim sTemp As String
Dim iFileNum As Integer
Dim oldFDF As String
Dim i As Integer
Dim lastRow As Integer
Dim sht As Worksheet
Set sht = Sheets("owssvr")
With sht
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For i = 2 To lastRow
oldPDF = "mydoc.pdf"
oldFDF = "mydoc_data.fdf"
newPDF = "" & i & ".pdf"
iFileNum = FreeFile
Open oldFDF For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & vbCrLf
Loop
Close iFileNum
sTemp = Replace(sTemp, "<</T(some form field)/V( )>>", "<</T(some form field)/V(" & sht.Range("E" & i) & ")>>")
iFileNum = FreeFile
oldFDF = "" & i & ".fdf"
Open oldFDF For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
Set objAcroApp = CreateObject("AcroExch.App")
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
boResult = objAcroAVDoc.Open(oldPDF, "")
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
Set jsObj = objAcroPDDoc.GetJSObject
jsObj.ImportAnFDF oldFDF
jsObj.SaveAs newPDF
boResult = objAcroAVDoc.Close(True)
boResult = objAcroApp.Exit
Next i
End Sub