word to pdf

 

< %  '  vb操作word類
Class clsWord
' 私有變量
Private  wdApp            ' Word對象
Private  wdSel            ' 光標位置
' Private comm As clsCommon
Private  fileName         ' 保存的文件名


Private   Sub  Class_Initialize()
     ' 創建Word對象
     Set  wdApp  =   CreateObject ( " Word.Application " )
     ' Set comm = New clsCommon
    wdApp.Visible  =   False                     ' 不顯示Word界面
    wdApp.DisplayAlerts  =   0        ' 不顯示提示    
End Sub

Private   Sub  Class_Terminate()
     ' 釋放資源
     If   Not  wdApp  Is   Nothing   Then
         If  wdApp.Documents.Count  <>   0   Then  wdApp.Documents.Close  False
        wdApp.Quit  False
         Set  wdSel  =   Nothing         
         Set  wdApp  =   Nothing
     End   If
     ' Set comm = Nothing
End Sub

' ************************************************************************************************************************
' *程式功能 :  獲取文檔
' *開發人員 :  yujie.huang 2006/05/17
' *異動人員
' *傳入值 : 1.inFileName                 操作的Word文件名稱
'           2.inFileTemplate             讀取的模版文件(可選參數，沒有模版則新建一個WordFile)
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  GetDocument(inFileName,inFileTemplate) 
On   Error   Resume   Next  
    fileName  =  inFileName
    wdApp.Documents.Add inFileTemplate
     Set  wdSel  =  wdApp.Selection
    GetDocument  =   True
If  Err.Number  <>   0   Then  GetDocument  =   False
     ' log
    response.write Err.Description
End Function

' ************************************************************************************************************************
' *程式功能 :  輸出文本
' *開發人員 :  yujie.huang 2006/05/17
' *異動人員
' *傳入值 : 1.inText                     文本字符串
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  DrawText(inText)
On   Error   Resume   Next  
     if  inText  <>   ""   then  wdSel.TypeText inText
    DrawText  =   True
If  Err.Number  <>   0   Then  DrawText  =   False
     ' log
     ' comm.WriteErrLog "clsWord", "DrawText", Err.Description, Err.Number, Err.Description
End Function

' ************************************************************************************************************************
' *程式功能 :  輸出文本
' *開發人員 :  yujie.huang 2006/05/17
' *異動人員
' *傳入值 : 1.inText                     文本字符串
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  DrawBorderChar(Char)
On   Error   Resume   Next
     if  Char  <>   ""   then
       wdSel.TypeText Char
       wdSel.MoveLeft  1 ,  Len (Char),  1                   ' 選擇文本
       wdSel.Range.ModifyEnclosure  2 , 1    ' 大方框
       wdSel.MoveRight  1 , Len (Char) 
     End   if
    DrawText  =   True
If  Err.Number  <>   0   Then  DrawText  =   False
     ' log
     ' comm.WriteErrLog "clsWord", "DrawText", Err.Description, Err.Number, Err.Description
End Function

' ************************************************************************************************************************
' *程式功能 :  刪除inCount個字符
' *開發人員 :  yujie.huang 2006/05/17
' *異動人員
' *傳入值 : 1. inCount              字符數
' *回傳值 :
' ************************************************************************************************************************
Public   Function  DeleteChr(inCount )
On   Error   Resume   Next  
    wdSel.Delete  1 , inCount
    DeleteChr  =   True
If  Err.Number  <>   0   Then  DeleteChr  =   False
End Function

' ************************************************************************************************************************
' *程式功能 :  光標移動到inBookmark書簽
' *開發人員 :  yujie.huang 2006/05/26
' *異動人員
' *傳入值 : 1.inBookmark                 書簽
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  GoToBookmark(inBookmark)
On   Error   Resume   Next  
    wdSel.GoTo  - 1 , , , inBookmark
    GoToBookmark  =   True
If  Err.Number  <>   0   Then  GoToBookmark  =   False
     ' log
     ' comm.WriteErrLog "clsWord", "GoToBookmark", Err.Description, Err.Number, Err.Description
End Function

' ************************************************************************************************************************
' *程式功能 :  插入打勾的框
' *開發人員 :  yujie.huang 2006/07/14
' *異動人員
' *傳入值 : 1.inBookmark                 書簽
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  InsertSymbol()
    wdSel.InsertSymbol  - 4014 ,  " Wingdings 2 " ,  True
    InsertSymbol  =   True
If  Err.Number  <>   0   Then  InsertSymbol  =   False
    response.write Err.description
End Function
' ************************************************************************************************************************
' *程式功能 :  保存
' *開發人員 :  yujie.huang 2006/05/17
' *異動人員
' *傳入值 : 無
' *回傳值 : boolean 成功=true，失敗=false
' ************************************************************************************************************************
Public   Function  Save() 
On   Error   Resume   Next      
    wdApp.Documents( 1 ).SaveAs fileName    
    Save  =   True
If  Err.Number  <>   0   Then  Save  =   False
     ' log
     ' comm.WriteErrLog "clsWord", "Save", Err.Description, Err.Number, Err.Description
End Function

End  Class
% >
< %  ' word to pdf
     Function  WordToPdf(docFile,pdfFile)
     On   Error   Resume   Next  
         Set  fso  =  Server.CreateObject( " Scripting.FileSystemObject " )
         Set  word  =  Server.CreateObject( " Word.Application " )
         Set  PDF  =  Server.CreateObject( " PDFDistiller.PDFDistiller.1 " )
        
         ' fso.GetFile(pdffile).Delete()
        
        logFile  =  fso.GetParentFolderName(pdfFile)  &   " "   &  fso.GetBaseName(pdfFile)  &   " .log "
        psfile   =  fso.GetParentFolderName(pdfFile)  &   " "   &  fso.GetBaseName(pdfFile)  &   " .ps "
        word.ActivePrinter  =   " docuPrinter "     ' The printer name
         ' word.ActivePrinter = "Microsoft Office Document Image Writer"
         Set   doc  =  word.Documents.Open(docfile)
        word.DisplayAlerts  =   0
        word.PrintOut  false ,  false ,  0 , psfile
        
        doc.Close( 0 )

        PDF.FileToPDF psfile,pdffile, ""
        
        fso.GetFile(psfile).Delete()
        fso.GetFile(logfile).Delete()

        word.Quit  false
    
         Set  word  =   Nothing  
         Set  fso  =   Nothing  
         Set  PDF  =   Nothing  
        WordToPdf  =   True  
         If  Err.Number  <>   0   Then  WordToPdf  =   False  
     End Function  
% >

上述代碼中需要一個pdf打印機，推薦docuPrinter網上有免費版本。