Operation Excel - introduced Excel data into Notes in Lotus

zhaozj2021-02-12  167

Const ExcelName = "D: Archive Retrieval .xls"

DIM session as new notessession

DIM DB AS NotesDatabaseDoase

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"

Formname = "frmhanjian"

Dim Excel As Variant

DIM XLWORKBOOK As Variant

Dim xlsheet as variant

SET Excel = CreateObject ("excel.application.9" ''

Excel.Workbooks.open ExcelName ''

Set XLWORKBOOKS.IXTEL.WORKBOOKS.ITEM (1)

Set Xlsheet = XLWORKBOOK.WORKSHEETS ("Hospital News Letter"

DIM INTROWCOUNT AS INTEGER

Introwcount = 1100

Row = 0

Written = 0

DIM Deplist List As String

DEPLIST ("DEP1" = "Party Committee"

Deplist ("DEP2" = "Supervision Office"

Deplist ("dec3" = "work"

DEPLIST ("DEP4" = "group committee"

Depllick ("DEP5" = "Office Office"

DEPLIST ("DEP6" = "People's Education"

Deplist ("DEP7" = "Finance"

DEPLIST ("DEP8" = "Property Company"

Deplist ("DEP9" = "Security Office"

Deplist ("DEP11 =" Review Office "

Deplist ("DEP12" = "Battalry"

Deplist ("DEP13" = "Traffic"

DIM DepName As String

For row = 3 to InTrowcount

With xlsheet

Temp1 = "wenhao"

Temp2 = "zenrenzhe"

Temp3 = "Subject"

TEMP4 = "YECI"

Temp5 = "qixian"

Temp6 = "juanhao"

IF CHECK (Xlsheet, Row, Depname) THEN

SET DOC = DB.CREATEDOCUMENT

Doc.form = formname

Call doc.replaceItemValue (Temp1, .cells (Row, 2 .value

Call doc.replaceItemvalue (Temp2, .cells (Row, 3 .value

Call Doc.replaceItemValue (Temp3, .cells (Row, 4 .value

Call Doc.replaceItemValue (Temp4, .cells (Row, 5.Value

Call Doc.replaceItemValue (Temp5, .cells (Row, 6 .Value

Call Doc.replaceItemValue (Temp6, .cells (Row, 7.Value

Call Doc.save (True, True

END IF

End with

NEXT

XLWORKBOOK.CLOSE FALSE

Excel.quit

Set Xlsheet = Nothing

SET EXCEL = Nothing

Print "" ''

EXIT SUB

Error_Call:

Print Error "==========" CSTR (ERL)

XLWORKBOOK.CLOSE FALSE

Excel.quit

Set Xlsheet = Nothing

SET EXCEL = Nothing

EXIT SUB

End Sub

转载请注明原文地址:https://www.9cbs.com/read-7252.html

New Post(0)