利用notes客户端将 domino数据导出到excel

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
 Set doc = collection.GetFirstDocument()
 
 If (doc Is Nothing) Then
 Messagebox("请选择你要导出的记录！")
 exit sub
 end if

 filenames = ws.SaveFileDialog(False,"导出到Excel",, "D:/", "assets.xls")
 
 If Isempty(filenames) Then Exit Sub
 
 Set excelApplication = CreateObject("Excel.Application")
 excelApplication.Visible = True
 Set excelWorkbook = excelApplication.Workbooks.Add
 Set excelSheet = excelWorkbook.Worksheets("Sheet1")
 
 '根据选中要导出的字段来设置excle的第一列
 
 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 = "责任人"
 
 i = 2

 While Not(doc Is Nothing)
  excelSheet.Cells(i,1).Value = doc.NumberID(0)
  excelSheet.Cells(i,2).Value = doc.pc(0)
 
  excelSheet.Cells(i,3).Value = doc.Brand(0)+"  "+doc.Type1(0)
  excelSheet.Cells(i,4).Value = ""
  excelSheet.Cells(i,5).Value = doc.BU(0)+"/"+doc.CDep(0)
  excelSheet.Cells(i,6).Value = doc.owner(0)
 
  i = i+1
  Set doc = collection.GetNextDocument(doc)
  'Set doc = view.GetNextDocument(doc)
 Wend
 
 excelWorkbook.SaveAs(filenames(0))
 excelApplication.Quit
 Set excelApplication = Nothing
 
 'Call uidoc.Close()
 
End Sub