lotusscript操作word文件

最近做了一个模块,功能是把word文件的数据引入lotus,word文件中的数据是表,大约300个相同格式的表格,
 代码如下:
 Sub Initialize
 %REM
 @author:snowdot23 @time:2004-1-10
 @description:
  import some datas of tables from word,and write its to notes,show its in the web;

 %END REM
 
  Const wName="d:全引目录.doc"
  Dim session As New NotesSession
 
  Dim view As NotesView
  Dim doc As NotesDocument
  Set db = session.CurrentDatabase
  Set doc = New NotesDocument(db)
  Dim item As NotesItem
  Dim One As String
  Dim row As Integer
  Dim written, records,ver  As Integer
  Dim FName As String
  Dim VName As String
  Dim xlFilename As String
  On Error Goto Error_call
 
  ''Set view = db.GetView("Import" 
 
  FormNamedoc= "frmdoc" 
 
  formnameml="frmjuanml"
 
 
  Dim  application As Variant
  Dim Word As Variant
 
 
  Set application= CreateObject( "Word.Application.9"  ''
  ''Set word =application.Documents.Open(wName)
  Application.Visible = False
  Set word =application.Documents.Open(wName,True)
  Call word .Activate
 
  Dim intRowCount As Integer
  intRowCount=1100
  Dim table As Variant
  Dim ocell As Variant
  Dim myrange As Variant
  ''word.Tables.Count
  If word.Tables.Count>0 Then
   For i=1 To word.Tables.Count
    Set table=word.Tables(i)
    ''createdocml(table)
    Dim docml As NotesDocument
    Set  docml = db.CreateDocument
    Dim datStart As String
    Dim datStop As String
   
    Dim objselect As Variant
    docml.Form = "frmjuanml"
   
   
   
    With table
 //取出表中第一行第二个单元格的值
     Set oc = table.Rows(1).Cells(2)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1) //单元格的文本值
     Call  docml.ReplaceItemValue( temp1,Trim(myrange.Text)) ''取得年度域值
     Set oc = table.Rows(1).Cells(4)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Call  docml.ReplaceItemValue( temp2,Trim(myrange.Text))
     Set oc = table.Rows(1).Cells(6)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Call  docml.ReplaceItemValue( temp3,Trim(myrange.Text))
     Set oc = table.Rows(2).Cells(2)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Call  docml.ReplaceItemValue( temp4,Trim(myrange.Text))
     Set oc = table.Rows(2).Cells(4)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Dim   wordD As  wordDate
     Set  wordD=New  wordDate(Trim(myrange.Text))
     datstart=wordD.getStartDate()
     datstop=wordD.getStopDate()
     Call  docml.ReplaceItemValue( temp5,datStart)
     Call  docml.ReplaceItemValue( temp6,datStop)
     Set oc = table.Rows(2).Cells(6)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Call  docml.ReplaceItemValue( temp7,Trim(myrange.Text))
    
     Set oc = table.Rows(3).Cells(2)
     Set myrange = word.Range(oc.Range.Start, _
     oc.Range.End - 1)
     Call  docml.ReplaceItemValue("subject", Trim(myrange.Text))
    
    
     Call docml.Save(True,True)
    
    End With
   
    Call createDocDoc(docml,word,table)
   Next

   Set ocell=Nothing
   Set myrange=Nothing
   Set table=Nothing
  
  End If

  row = 0
  written = 0

  word.Close 
  application.Quit
  Set word =Nothing
  Set application = Nothing
  Print " " '' 
  Exit Sub
 Error_call:
  Print Error +"=========="+Cstr(Erl)
  application.Close
  Excel.Quit
  Set word =Nothing
  Set application = Nothing
  Exit Sub
 End Sub