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
