该例以简单的资产库为背景,可以将excel的内容导入到notes数据库,同时也实现了多个sheet的excel的同时导入
Sub Click(Source As Button)
'-------------------------------------------------------------
'-- Admin 资产导入--
'-------------------------------------------------------------
Dim ws As New notesuiworkspace
Dim ss As New notessession
Dim db As notesdatabase
Dim item As notesitem
Dim files As Variant
Dim schar As String
Dim doc As NotesDocument
Dim cpdoc As NotesDocument
Dim excelapplication
Dim i,sheet
Set db = ss.currentdatabase
files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
sheeet = 1
If Not(Isempty(files)) Then
Set excelapplication = createobject("excel.application")
Set excelworkbook = excelapplication.workbooks.open(files)
'多个sheet循环
Do Until Cstr(excelsheet.cells(i,sheet).value) =""
Set excelsheet = excelworkbook.worksheets(1)
i = 2
'一个sheet里面所有记录循环
Do Until Cstr(excelsheet.cells(i,1).value) =""
Set cpdoc = New notesdocument(db)
cpdoc.Form = "assets"
cpdoc.import_flag = Str(Today()) '指定导入批次为导入日期
cpdoc.NumberID = excelsheet.cells(i,1).value
cpdoc.company = excelsheet.cells(i,2).value
cpdoc.Type = excelsheet.cells(i,3).value
cpdoc.Admin_NumberID = excelsheet.cells(i,4).value
cpdoc.state = excelsheet.cells(i,5).value
cpdoc.ID = excelsheet.cells(i,6).value
cpdoc.date = excelsheet.cells(i,7).value
cpdoc.Area = excelsheet.cells(i,8).value
cpdoc.location = excelsheet.cells(i,9).value
cpdoc.pc = excelsheet.cells(i,10).value
Call cpdoc.save(False,False)
Loop
Loop
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
End Sub