lotusscript操作word文件

博主最近开发了一个模块,功能是把Word文件里约300个相同格式表格的数据引入Lotus。文中给出了具体代码,包含数据读取、文档创建、数据替换和保存等操作,最后关闭Word应用并处理异常。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

最近做了一个模块,功能是把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

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值