一个从lotus到word的类

%REM ##############################################################################################

 Sub     new          (xlFilename As String, isVisible As Boolean)
 Sub    Delete         ()
 Function  writeTextToBookmark    (NotesText as String, BookmarkName as String)
 Function   save          ()
 Function  saveAs         (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) Then  wordApp.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