INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

COM and Automation

Automatic MS Office to PDF Module by baltman
Posted: 25 Oct 03 (Edited 28 Oct 03)

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&           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.
   .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

Back to Microsoft: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close