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網上有免費版本。