Recently made a module, the function is to introduce the data of the Word file into Lotus. The data in the Word file is a table, the table, the code, the code is as follows: 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: primer Directory Full .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 = "frmjuanl" with table // Take the first line of the first line of the second cell set OC = Table.Rows (1) .cells (2) set myrange = word.range (Oc.Range.Start, _ Oc.Range.end - 1) // Cells text value Call Docml.replaceItemValue (TEMP1, TRIM (MyRange.Text) ) '' Get the annual domain value set = table.rows (1) .cells (4) set myrange = word.range (oc.range.start, _ ore.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.Tex T)) Call Docml.SAve (True, True) End With Call Createdocdoc (DOCML, WORD, TABLE) NextSet Ocell = Nothing Set MyRange = Nothing Set Table = Nothing endiff
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
