Sub Click(Source As Button)
 Dim ws As New NotesUIWorkspace
 
 Dim ss As New NotesSession
 Dim db As NotesDatabase
 Dim dc As NotesDocumentCollection
 Dim doc As NotesDocument
 
 Set db=ss.CurrentDatabase
 Set dc=db.AllDocuments
 Dim xlapp As Variant
 Dim xlsheet As Variant
 Set xlapp=createobject("Excel.Application")
 xlapp.statusbar="正在创建工作表，请稍等... ..."
 xlapp.visible=True
 xlapp.workbooks.add
 xlapp.referencestyle=2
 Set xlsheet=xlapp.workbooks(1).worksheets(1)
 xlsheet.visible=True
 xlsheet.name="日海公文库"
 xlsheet.Columns("a:n").Font.Size=9
 xlsheet.Columns("n:n").columnwidth=30
 xlsheet.cells(1,1).value="部门"
 xlsheet.cells(1,2).value="公文编号"
 xlsheet.cells(1,3).value="主题"
 xlsheet.cells(1,4).value="发布人"
 xlsheet.cells(1,5).value="生效日期"
 
 Dim rows As Integer
 rows=2
 Set doc=dc.GetFirstDocument
 While Not(doc Is Nothing)
  xlsheet.cells(rows,1).value=doc.GetItemValue("bm")(0)
  xlsheet.cells(rows,2).value=doc.GetItemValue("bh")(0)
  xlsheet.cells(rows,3).value=doc.GetItemValue("zt")(0)
  xlsheet.cells(rows,4).value=doc.GetItemValue("fbr")(0)
  xlsheet.cells(rows,5).value=doc.GetItemValue("sxrq")(0)
  Set doc=dc.GetNextDocument(doc)
  rows=rows+1
 Wend
 xlapp.referencestyle=1
 xlapp.statusbar="数据导出完成"
End Sub