hello -
i using excel 2007 vba try add data (fields) pdf document. code worked once before (i not original writer), reason, code errors error message "run-time error '429': activex component can't create object" on following line of code:
set acform = createobject("aformaut.app")
i have adobe acrobat 9 pro (9.3.1). not sure begin problem. have tried adding reference aformaut 1.0 type library , using early-bound objects vs late-bound objects, doesn't seem make difference.
full code:
'on error goto pastetableinpdf_error
dim fontsize single
dim rowheight single
dim margins single
'dim mydoc acropddoc
'dim myavd acroavdoc
dim acform aformautlib.aformapp
dim mydoc object, myavd object ', acform object ' doing these late-bound, instead, avoid using direct reference
dim f object
dim curtoolsheet new toolsheet
dim itemnum integer, x integer ' for-loop iterators
dim header variant
dim tmpx single, tmpy single
dim tablex single, tabley single
dim longrowy single
dim numcols integer, lastcol integer ' total number of columns table , col# of last header started table
dim colwidths single
dim currng range ' current range we're reading in metadata spreadsheet
dim savefolder string ' folder save files in
dim curfile string, curdocname string ' names of current file , without path
dim curid string ' id or uin of current file
dim curheadercol integer
dim fdobj filedialog ' object needed opening
dim fsobj filesystemobject
dim frmsetup new frmpdfmetadatatable
dim tmprange range
' check data on sheet
if curtoolsheet.blank then
msgbox "no data found on spreadsheet!" & vbcr & _
"this script take data spreadsheet , put them into" & vbcr & _
"metadata tables on bottom of pdf items." & vbcr & _
"please paste metadata on sheet. make sure light green row" & vbcr & _
"contains column headers , data follows underneath." & vbcr & _
"the script copy each line respective item.", title:=itmsgtitle
goto pastetableinpdf_exit
end if
' extract font size userform
frmsetup.show
if frmsetup.tag <> "ready" goto pastetableinpdf_exit
fontsize = val(frmsetup.txbfontsize.value)
margins = val(frmsetup.txbmargins.value)
rowheight = val(frmsetup.txbrowht.value)
if not frmsetup.ckbautofontsize.value then
if fontsize * rowheight = 0 then
msgbox ("must enter row height , default font size!")
goto pastetableinpdf_exit
end if
else
fontsize = 0
end if
' save folder , file listing
msgbox "please first select folder in want save new pdfs." & vbcr & _
"then, on following screen, select actual files want process", title:=itmsgtitle
set fdobj = application.filedialog(msofiledialogfolderpicker)
fdobj
.title = "please select folder want save new pdfs to..."
if .show = -1 savefolder = .selecteditems(1) else goto pastetableinpdf_exit
end with
set fdobj = application.filedialog(msofiledialogfilepicker)
fdobj
.title = "please select pdfs want process..."
.initialfilename = ""
.filters.clear
.filters.add "pdf items", "*.pdf"
.allowmultiselect = true
'*******************************************************
' ok pressed , items selected, let's work!
if .show = -1 then
'set mydoc = new acropddoc
set mydoc = createobject("acroexch.pddoc")
' process actual files now...
' ...first, extract filename info , open file
itemnum = 1 .selecteditems.count
lastcol = 1
tablex = margins
curfile = .selecteditems(itemnum)
curdocname = mid(.selecteditems(itemnum), instrrev(.selecteditems(itemnum), "\"))
mydoc.open curfile ' opens pdf doc
set myavd = mydoc.openavdoc(curdocname) ' creates window pdf doc
'set acform = new aformapp ' attach recent pdf doc window
set acform = createobject("aformaut.app")
curid = extractuin(curdocname)
set currng = curtoolsheet.sheet.usedrange.find(curid, lookat:=xlpart)
' make sure itemid found in spreadsheet....
if currng nothing then
msgbox ("uh oh! " & curid & " not found in spreadsheet!" & vbcr & _
"moving on...")
else
set currng = cells(currng.row, 1)
tabley = margins
' draw text boxes @ intervals
each header in curtoolsheet.headers
curheadercol = curtoolsheet.headers(header) ' assign col # of header x
if left(header, 1) = "|" or curheadercol = 1 then ' start of new table...
x = 0
set tmprange = curtoolsheet.headerrow.cells(1, curheadercol + 1)
while left(tmprange.value, 1) <> "|" , tmprange.value <> "" , tmprange.column <> 256
if left(tmprange.value, 1) = "\" x = x + 1 ' count number of long rows ($ prefixes) there before next table
set tmprange = tmprange.cells(1, 2)
wend
numcols = tmprange.column - lastcol - x
lastcol = tmprange.column
colwidths = (pppagewidth - (2 * margins)) / numcols
tmpx = tablex
tabley = tabley + rowheight * (x + 3) ' move next table spot, make enough room , 1 blank row between tables
longrowy = tabley - 2 * rowheight
end if
' draw headers
if left(header, 1) = "\" then
set f = acform.fields.add(header & itemnum & "-val", "text", 0, tablex, longrowy, tablex + colwidths * 1.5, longrowy - rowheight)
else
set f = acform.fields.add(header & itemnum & "-val", "text", 0, tmpx, tabley, tmpx + colwidths, tabley - rowheight)
end if
f.value = iif(left(header, 1) = "\" or left(header, 1) = "|", mid(header, 2), header)
f.setbordercolor "rgb", 0, 0, 0, 0
f.alignment = "center"
if fontsize > 0 f.textsize = fontsize
' draw values, left right
if left(header, 1) = "\" then ' draw long row @ bottom of table
set f = acform.fields.add(header & itemnum, "text", 0, tablex + colwidths * 1.5, longrowy, tablex + colwidths * numcols, longrowy - rowheight)
longrowy = longrowy + rowheight
f.alignment = "left"
else
set f = acform.fields.add(header & itemnum, "text", 0, tmpx, tabley - rowheight, tmpx + colwidths, tabley - 2 * rowheight)
tmpx = tmpx + colwidths
f.alignment = "center"
end if
f.value = currng.cells(1, curheadercol)
f.ismultiline = true
f.setbordercolor "rgb", 0, 0, 0, 0
if fontsize > 0 f.textsize = fontsize
next header
currng.cells(1, curheadercol + 1).value = "pdf processed"
end if 'itemid found
' save doc , shut down pdf window
mydoc.save 1, savefolder & curdocname ' 1 = pdsaveflags.pdsavefull
set acform = nothing
set f = nothing
myavd.close (1)
mydoc.close
next itemnum
end if
end with
columns(activesheet.usedrange.columns.count).autofit
pastetableinpdf_exit:
if not myavd nothing then
myavd.close false
mydoc.close
end if
set fdobj = nothing ' free memory
set frmsetup = nothing
set f = nothing
set myavd = nothing
set mydoc = nothing
set acform = nothing
set currng = nothing
exit function
pastetableinpdf_error:
msgbox err.description
on error goto 0
resume pastetableinpdf_exit
any appreciated.
nevermind. figured out, though don't understand why made difference. missing following:
set myapp = createobject("acroexch.app")
for having same issue, ended following code (changes in bold):
public function pastetableinpdf()
'on error goto pastetableinpdf_error
dim fontsize single
dim rowheight single
dim margins single
'dim mydoc acropddoc
'dim myavd acroavdoc
'dim acform aformautlib.aformapp
dim myapp object, mydoc object, myavd object, acform object ' doing these late-bound, instead, avoid using direct reference
dim f object
dim curtoolsheet new toolsheet
dim itemnum integer, x integer ' for-loop iterators
dim header variant
dim tmpx single, tmpy single
dim tablex single, tabley single
dim longrowy single
dim numcols integer, lastcol integer ' total number of columns table , col# of last header started table
dim colwidths single
dim currng range ' current range we're reading in metadata spreadsheet
dim savefolder string ' folder save files in
dim curfile string, curdocname string ' names of current file , without path
dim curid string ' id or uin of current file
dim curheadercol integer
dim fdobj filedialog ' object needed opening
dim fsobj filesystemobject
dim frmsetup new frmpdfmetadatatable
dim tmprange range
' check data on sheet
if curtoolsheet.blank then
msgbox "no data found on spreadsheet!" & vbcr & _
"this script take data spreadsheet , put them into" & vbcr & _
"metadata tables on bottom of pdf items." & vbcr & _
"please paste metadata on sheet. make sure light green row" & vbcr & _
"contains column headers , data follows underneath." & vbcr & _
"the script copy each line respective item.", title:=itmsgtitle
goto pastetableinpdf_exit
end if
' extract font size userform
frmsetup.show
if frmsetup.tag <> "ready" goto pastetableinpdf_exit
fontsize = val(frmsetup.txbfontsize.value)
margins = val(frmsetup.txbmargins.value)
rowheight = val(frmsetup.txbrowht.value)
if not frmsetup.ckbautofontsize.value then
if fontsize * rowheight = 0 then
msgbox ("must enter row height , default font size!")
goto pastetableinpdf_exit
end if
else
fontsize = 0
end if
' save folder , file listing
msgbox "please first select folder in want save new pdfs." & vbcr & _
"then, on following screen, select actual files want process", title:=itmsgtitle
set fdobj = application.filedialog(msofiledialogfolderpicker)
fdobj
.title = "please select folder want save new pdfs to..."
if .show = -1 savefolder = .selecteditems(1) else goto pastetableinpdf_exit
end with
set fdobj = application.filedialog(msofiledialogfilepicker)
fdobj
.title = "please select pdfs want process..."
.initialfilename = ""
.filters.clear
.filters.add "pdf items", "*.pdf"
.allowmultiselect = true
'*******************************************************
' ok pressed , items selected, let's work!
if .show = -1 then
set myapp = createobject("acroexch.app")
'set mydoc = new acropddoc
set mydoc = createobject("acroexch.pddoc")
' process actual files now...
' ...first, extract filename info , open file
itemnum = 1 .selecteditems.count
lastcol = 1
tablex = margins
curfile = .selecteditems(itemnum)
curdocname = mid(.selecteditems(itemnum), instrrev(.selecteditems(itemnum), "\"))
mydoc.open curfile ' opens pdf doc
set myavd = mydoc.openavdoc(curdocname) ' creates window pdf doc
'set acform = new aformapp ' attach recent pdf doc window
set acform = createobject("aformaut.app")
curid = extractuin(curdocname)
set currng = curtoolsheet.sheet.usedrange.find(curid, lookat:=xlpart)
' make sure itemid found in spreadsheet....
if currng nothing then
msgbox ("uh oh! " & curid & " not found in spreadsheet!" & vbcr & _
"moving on...")
else
set currng = cells(currng.row, 1)
tabley = margins
' draw text boxes @ intervals
each header in curtoolsheet.headers
curheadercol = curtoolsheet.headers(header) ' assign col # of header x
if left(header, 1) = "|" or curheadercol = 1 then ' start of new table...
x = 0
set tmprange = curtoolsheet.headerrow.cells(1, curheadercol + 1)
while left(tmprange.value, 1) <> "|" , tmprange.value <> "" , tmprange.column <> 256
if left(tmprange.value, 1) = "\" x = x + 1 ' count number of long rows ($ prefixes) there before next table
set tmprange = tmprange.cells(1, 2)
wend
numcols = tmprange.column - lastcol - x
lastcol = tmprange.column
colwidths = (pppagewidth - (2 * margins)) / numcols
tmpx = tablex
tabley = tabley + rowheight * (x + 3) ' move next table spot, make enough room , 1 blank row between tables
longrowy = tabley - 2 * rowheight
end if
' draw headers
if left(header, 1) = "\" then
set f = acform.fields.add(header & itemnum & "-val", "text", 0, tablex, longrowy, tablex + colwidths * 1.5, longrowy - rowheight)
else
set f = acform.fields.add(header & itemnum & "-val", "text", 0, tmpx, tabley, tmpx + colwidths, tabley - rowheight)
end if
f.value = iif(left(header, 1) = "\" or left(header, 1) = "|", mid(header, 2), header)
f.setbordercolor "rgb", 0, 0, 0, 0
f.alignment = "center"
if fontsize > 0 f.textsize = fontsize
' draw values, left right
if left(header, 1) = "\" then ' draw long row @ bottom of table
set f = acform.fields.add(header & itemnum, "text", 0, tablex + colwidths * 1.5, longrowy, tablex + colwidths * numcols, longrowy - rowheight)
longrowy = longrowy + rowheight
f.alignment = "left"
else
set f = acform.fields.add(header & itemnum, "text", 0, tmpx, tabley - rowheight, tmpx + colwidths, tabley - 2 * rowheight)
tmpx = tmpx + colwidths
f.alignment = "center"
end if
f.value = currng.cells(1, curheadercol)
f.ismultiline = true
f.setbordercolor "rgb", 0, 0, 0, 0
if fontsize > 0 f.textsize = fontsize
next header
currng.cells(1, curheadercol + 1).value = "pdf processed"
end if 'itemid found
' save doc , shut down pdf window
mydoc.save 1, savefolder & curdocname ' 1 = pdsaveflags.pdsavefull
set acform = nothing
set f = nothing
myavd.close (1)
mydoc.close
next itemnum
end if
end with
columns(activesheet.usedrange.columns.count).autofit
pastetableinpdf_exit:
if not myavd nothing then
myavd.close false
mydoc.close
end if
if not myapp nothing myapp.exit
set fdobj = nothing ' free memory
set frmsetup = nothing
set f = nothing
set myavd = nothing
set mydoc = nothing
set acform = nothing
set currng = nothing
exit function
pastetableinpdf_error:
msgbox err.description
on error goto 0
resume pastetableinpdf_exit
end function
More discussions in Acrobat SDK
adobe
Thanks heaps - that was exactly what my code was missing (wasn't obvious from Adobe SDK). Cheers.
ReplyDelete