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