如何利用代理创建WORD文档

曾经收集的使用代理创建Word文档的一段代码，现在贴出来分享

需要注意的是，如果是B/s下使用，则服务器上必须安装又MS Word，否则会报错哦

1、代理Create Word Document
Option Public
Use "WordReport"

Sub Initialize
Dim ws As New NotesUIWorkspace
Dim view As NotesView
Dim wordfilepath As String

wordfilepath= ""' create an empty file

Set view = ws.CurrentView.View
Set report = New WordReport(wordfilepath, False)

'Call report.writeTextToBookmark("TestBookmark", "Test")
Call report.setVisibility(True)
End Sub

2、WordReport脚本库的代码
%REM ##############################################################################################

Sub new(xlFilename As String, isVisible As Boolean)
SubDelete()
FunctionwriteTextToBookmark(NotesText as String, BookmarkName as String)
Function save()
FunctionsaveAs(filename as String)
Function quit()
Function setVisibility(isVisible As Boolean)
Function getVersion() As String

'-----------------------------------------------------------------
Example Code inside an application database:

Const WORDPATH= "C:/temp/TestWord.doc"

Dim session As New NotesSession
Dim db As NotesDatabase
Dim report As WordReport

Set db = session.CurrentDatabase
Set report= new WordReport (WORDPATH, false)' false = don't show word

Messagebox report.getversion()

Call report.writeTextToBookmark("Bookmark1", "Hello world")' bookmark must exist in word template
Call report.setVisibility(true)

%END REM ##############################################################################################

'-------------------------------------------------------------
' General
'-------------------------------------------------------------
Const WORD_APPLICATION= "Word.application"

'-------------------------------------------------------------
' Errors
'-------------------------------------------------------------
Private Const BASEERROR= 1100

'-------------------------------------------------------------
' Version Information
'-------------------------------------------------------------
Const REG_97= "Software//Microsoft//Office//8.0//Common//InstallRoot"'Registry Key Office 97
Const REG_2000= "Software//Microsoft//Office//9.0//Common//InstallRoot"'Registry Key Office 2000
Const REG_XP= "Software//Microsoft//Office//10.0//Common//InstallRoot"'Registry Key Office XP
Const REG_2003="Software//Microsoft//Office//11.0//Common//InstallRoot"'Registry Key Office 2003

Const NAME_97= "Office 97"
Const NAME_2000= "Office 2000"
Const NAME_XP= "Office XP"
Const NAME_2003= "Office 2003"

'==================================================================================================
' Word Report
'==================================================================================================
Class WordReport

Private wordApp As Variant' Application object
Private wordDoc As Variant' Word document
Private strFilePath As String

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' constructor
'- creates the word application object
'- can use a file (.doc or .dot) as template
'- creates an wmpty document when filename is empty
' - application can be set to visible/invisible
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub new(wordFilename As String, isVisible As Boolean)
On Error Goto GeneralError

Set wordApp = CreateObject(WORD_APPLICATION)' open the application
wordApp.Documents.Add wordFilename' create a Word document
wordApp.Visible = isVisible' make it visible (or not)
Set wordDoc= wordApp.ActiveDocument' get document object for later use
strFilePath = wordFilename' store the filename

Goto ExitSub

GeneralError:
If Not (wordApp Is Nothing) Then wordApp.quit' quit, if there is an error
Resume ExitSub

ExitSub:
End Sub

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' destructor
' - is invoked when you delete the object via e.g. "delete report"
'- see "delete" keyword in help
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub Delete

End Sub

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' write text to a bookmark
' - a text is written to a predefined bookmark in the word document
'- 1 = bookmark was written successfully, 0 = error
'- using a bookmark twice inserts both texts: the second in front of the first
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function writeTextToBookmark(BookmarkName As String, textValue As String) As Integer

Dim wr As Variant

If wordDoc.Bookmarks.Exists(BookmarkName) Then
Set wr = wordDoc.Bookmarks(BookmarkName).Range
wr.InsertAfter textValue
writeTextToBookmark = 1

Else
writeTextToBookmark = 0
End If

End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' save file
' - file gets saved at the position where it was created from
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function save
wordDoc.SaveAs( strFilePath )
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' save file at a designated location
' - file gets saved at the designated location
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function saveAs(newFilename)
wordDoc.SaveAs( newFileName )
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' quit excel
'- quits word, if it is still running
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function quit
If Not (wordApp Is Nothing) Then
wordApp.Quit
Set wordApp = Nothing
End If
End Function

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' set visibility
'- switches between visible and invisible
'- does this if it makes sense only
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function setVisibility(isVisible As Boolean)
If (isVisible And Not wordApp.Visible) Then wordApp.Visible = True
If (Not isVisible And wordApp.Visible)ThenwordApp.Visible = False
End Function


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' get version
'- reads the currently installed Word (Office) version from the registry (Windows only)
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Public Function getVersion() As String

On Error Goto GeneralError

Dim formula As String
Dim SWVersion As String
Dim Versions List As String
Dim v As Variant

'----------------------------------------------------------------------
' Initialize all possible versions
'----------------------------------------------------------------------
Versions(NAME_97)= REG_97
Versions(NAME_2000)= REG_2000
Versions(NAME_XP)= REG_XP
Versions(NAME_2003)= REG_2003

'----------------------------------------------------------------------
' test for installed version
'----------------------------------------------------------------------
Forall vers In Versions
formula$ = | (@RegQueryValue("HKEY_LOCAL_MACHINE"; "| & vers & |";"Path")) |
v = Evaluate( formula$ )
If v(0) <> "" Then
getVersion = Listtag(vers)
Goto ExitSub
End If
End Forall

getVersion = ""

Goto ExitSub

GeneralError:

getVersion = ""
Resume ExitSub

ExitSub:
End Function
End Class