-domino excel导出,导出excel

运行这段代码的时候，必须保证Excel的数据格式与文档的数据格式一致，一个单元格对应一个域。
本代码从第二行开始读取，认为第一行是标题，而不是有用的数据。
本代码判断Excel数据已经读取完毕的条件是：准备读取的第一个单元格的内容为空。
导入后，刷新视图就可以显示数据了。

Sub Click(Source As Button)

Dim ws As New NotesUIWorkspace 'workspace
Dim ss As New NotesSession 'session
Dim db As NotesDatabase 'database
Dim files As Variant 'file name
Dim schar As String 'cell content
Dim doc As NotesDocument 'notes document
Dim excelapplication
Dim i,sheet
Set db = ss.currentdatabase
files = ws.openfiledialog(False,"请选择要导入的Excel文件","Excel file/*.xls")
sheeet = 1
If Not(Isempty(files)) Then '如果用户选择了文件，或者输入了文件名，那么就开始准备打开excel文件。
Set excelapplication = createobject("excel.application")
Set excelworkbook = excelapplication.workbooks.open(files)

If excelworkbook Is Nothing Then '如果未找到文件，则退出
excelapplication.quit
Exit Sub
End If
Set excelsheet = excelworkbook.worksheets(1)
i = 2 '从第二行开始读取
'一个sheet里面所有记录循环
Do Until Cstr(excelsheet.cells(i,1).value) =""
Set doc = New NotesDocument(db)
doc.Form = "物资计划"
doc.xmmc = excelsheet.cells(i,1).value '项目名称
doc.jhbh = excelsheet.cells(i,2).value '计划编号
doc.jhfypc = excelsheet.cells(i,3).value '计划发运批次
doc.clmc = excelsheet.cells(i,4).value '材料名称
doc.ggxh = excelsheet.cells(i,5).value '规格型号
doc.bz = excelsheet.cells(i,6).value '备注
doc.cz = excelsheet.cells(i,7).value '材质
doc.dw = excelsheet.cells(i,8).value '单位
doc.jhsl = excelsheet.cells(i,9).value '计划数量
doc.dhsjyq = excelsheet.cells(i,10).value '到货时间要求
doc.shyj = excelsheet.cells(i,11).value '审核意见
doc.cgr = excelsheet.cells(i,12).value '采购人
doc.ht_loadmark="Excel 导入 at " + Cstr(Now())
Call doc.save(False,False) '保存
i=i+1
Loop
excelworkbook.close(False)
excelapplication.quit
Set excelapplication = Nothing
End If
End Sub
------------------------------------------------------------------------

应当注意的是：如果当前视图一个文档也没有显式的选中（即用鼠标点取），那么lotus会自动默认选中第一条文档。
Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim curdoc As NotesDocument
Set uidoc = ws.CurrentDocument
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim session As New NotesSession
Dim excelApplication As Variant
Dim excelWorkbook As Variant
Dim excelSheet As Variant
Dim collection As notesdocumentcollection
Dim i,index1,index2 As Integer
Set db = session.CurrentDatabase
Set collection = db.UnprocessedDocuments 'UnprocessedDocuments是选中的文档集合
Set doc = collection.GetFirstDocument()
If (doc Is Nothing) Then
Messagebox("请选择你要导出的记录！e799bee5baa6e79fa5e98193e4b893e5b19e361")
Exit Sub
End If
filenames = ws.SaveFileDialog(False,"导出到Excel","Excel文件|*.xls", "C:", "物资计划按项目.xls")

If Isempty(filenames) Then '如果没有得到文件名，则提示后退出
Messagebox("未提供目标文件名称")
Exit Sub
End If

Set excelApplication = CreateObject("Excel.Application") '创建Excel对象
excelApplication.Visible = True '显示Excel
Set excelWorkbook = excelApplication.Workbooks.Add '添加表
Set excelSheet = excelWorkbook.Worksheets("Sheet1") '选中表
'第1行写标题
excelSheet.Cells(1,1).Value = "项目名称"
excelSheet.Cells(1,2).Value = "计划编号"
excelSheet.Cells(1,3).Value = "计划发运批次"
excelSheet.Cells(1,4).Value = "材料名称"
excelSheet.Cells(1,5).Value = "规格型号"
excelSheet.Cells(1,6).Value = "材质"
excelSheet.Cells(1,7).Value = "单位"
excelSheet.Cells(1,8).Value = "计划数量"
excelSheet.Cells(1,9).Value = "到货时间要求"
excelSheet.Cells(1,10).Value = "审核意见"
'从第2行开始写数据
i = 2
While Not(doc Is Nothing)
excelSheet.Cells(i,1).Value = doc.xmmc(0)
excelSheet.Cells(i,2).Value = doc.jhbh(0)
excelSheet.Cells(i,3).Value = doc.jhfypc(0)
excelSheet.Cells(i,4).Value = doc.clmc(0)
excelSheet.Cells(i,5).Value = doc.ggxh(0)
excelSheet.Cells(i,6).Value = doc.cz(0)
excelSheet.Cells(i,7).Value = doc.dw(0)
excelSheet.Cells(i,8).Value = doc.jhsl(0)
excelSheet.Cells(i,9).Value = doc.dhsjyq(0)
excelSheet.Cells(i,10).Value =doc.shyj(0)
i = i+1
Set doc = collection.GetNextDocument(doc)
Wend
excelWorkbook.SaveAs(filenames(0))
excelApplication.Quit
Set excelApplication = Nothing
Messagebox("文件已保存到" +filenames(0))
End Sub