Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Automatic MS Office to PDF Module

COM and Automation

Automatic MS Office to PDF Module

by  baltman  Posted    (Edited  )
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&& Automatic
&&&&&&& Excel/Word (and HTML w/Word)
&&&&&&& to PS to PDF Module
&&&&&&&
&&&&&&& Use with Bob Lee's ps2pdf
&&&&&&& Posted at Tek-Tips in FAQ
&&&&&&& faq184-2143 by mgagnon
&&&&&&&
&&&&&&& Brian Altman
&&&&&&& 10/25/2003
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

*Infile="MyXL.xls"
InFile="MyWord.doc"

&& Test to make sure file exists, if not go fish
IF FILE(InFile)=.f.
MissingFile=MESSAGEBOX("File no longer exists or was moved. Do you want to look for it?","Missing Input File",4)
IF MissingFile=6
InFile=GETFILE()
ELSE
RETURN
ENDIF
ENDIF

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&Flipped App to use depending on file extension
m.ext=UPPER(JUSTEXT(infile))
DO case
CASE m.ext=="RTF" OR m.ext=="DOC" OR m.ext=="HTM" OR m.ext=="HTML" OR m.ext=="TXT"
typeoffile="WORD"
CASE m.ext=="XLS" OR m.ext=="CSV"
typeoffile="XL"
OTHERWISE
MESSAGEBOX("Only File Extensions of 'XLS', 'CSV', 'DOC', 'RTF', 'TXT','HTM' and 'HTML' are currently supported","File Error",0)
RETURN
ENDCASE
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

If Not Directory("psfiles")
Mkdir psfiles
Endif
If Not Directory("pdffiles")
Mkdir pdffiles
Endif

&&Your PS (output) file to be used by Bob Lee's ps2pdf
PSfile=sys(5)+sys(2003)+"\Output.PS"
PrinterToUse="Lexmark Optra Color 1200 PS"

&&Your Current Default Printer so we can go back to it.
&&Saved as a text file so you can get it back by executing
&&the 'ON ERROR DO OLDPRINTER'
lcDefaultPrinter = SET("PRINTER",3)
STRTOFILE(lcDefaultPrinter,"oldprinter.txt")

PMISSING="N"
ON ERROR PMISSING="Y"
oNet = CREATEOBJECT("WScript.Network")
oNet.SetDefaultPrinter(PrinterToUse)

IF m.PMISSING="Y"
MESSAGEBOX("Please Add Printer '"+PrinterToUse+"' as a Print-to-File Printer"+CHR(13)+;
"Using 'Printers/Faxes->Add Printer Wizard' in the control pannel.","PS Printer Not Found",0)
RETURN
ENDIF

ON ERROR DO OLDPRINTER

&&Print the Excel File to a Postscript File
IF m.typeoffile="XL"
loExcel = CreateObject("Excel.Application")
WITH loExcel
.DisplayAlerts = .f.
.Visible=.f.
.Workbooks.Open(Infile)

&&Sendkeys automates the forced 'name output file' pop-up
&&You may have to tweak this line by adding an additional
&&{ENTER} or whatever depending on the interface presented
&&by your OS/Office version. This worked in Office XP.
&&Note the macro replacement for the file name.
Code:
   .SendKeys ["%f%l&PSFile{ENTER}"]

DECLARE Sleep IN Win32API INTEGER nMilliseconds
Sleep(1000) &&wait for a bit for the print box- might need to raise this for slow computers

&&Prints whole workbook, can use commented out code to print just 1st sheet
.ActiveWorkbook.PrintOut &&whole wb
*.ActiveWorkbook.PrintOut(1,.t.,.t.) &&1st sheet
.Quit
ENDWITH
loExcel=.null.
ELSE

loWord = CreateObject("Word.Application")
WITH loWord
.DisplayAlerts = .f.
.Visible=.f.
.Documents.Open(InFile)
.ActiveDocument.PrintOut(0,0,0,PSFile)
.Quit
ENDWITH
loWord=.null.
ENDIF

&&Return to original default printer
oNet.SetDefaultPrinter(lcDefaultPrinter)

&&Execute Bob Lee's ps2pdf assumed to be in same folder
ON ERROR
ps2pdf(PSfile)

&&If something goes wrong and you want your
&&original default printer back execute this code:
PROCEDURE OLDPRINTER
lcDefaultPrinter = FILETOSTR("oldprinter.txt")
oNet = CREATEOBJECT("WScript.Network")
oNet.SetDefaultPrinter(lcDefaultPrinter)
MESSAGEBOX("Error! Please Check Printer Driver and MS Office Availability."+CHR(13)+;
"Printer Returned to Default.","Conversion to PS Error",0)
ON ERROR
ENDPROC
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top