传递要导出的视图名和工作表名
Function OutputExcel(ViewName As String,SheetName As String)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As Notesview
Dim colls As NotesDocumentCollection
Dim doc As Notesdocument
Dim doc2 As Notesdocument
Dim excelapplication As Variant
Dim excelworkbook As Variant
Dim excelsheet As Variant
Dim i As Integer
Dim uvcols As Integer
Dim selection As Variant
path=session.GetEnvironmentString ("D:",True)
Set excelapplication=CreateObject("Excel.Application")
excelapplication.statusbar="正在创建工作表,请稍等.."
excelapplication.Visible=True
excelapplication.Workbooks.Add
excelapplication.referencestyle=2
Set excelsheet=excelapplication.Workbooks(1).worksheets(1)
excelsheet.name=SheetName '工作表的名字
Dim rows As Integer
Dim cols As Integer
Dim maxcols As Integer
Dim fieldname As String
Dim fitem As NotesItem
rows=1
cols=1
Set db=session.CurrentDatabase
Set view=db.GetView (ViewName)
Set colls=db.UnprocessedDocuments
uvcols=Ubound(view.Columns)
For x=0 To Ubound(view.Columns)
excelapplication.statusbar="正在创建单元格,请稍等.."
If view.Columns(x).IsHidden=False Then
If view.Columns(x).title<>"" Then
excelsheet.Cells(rows,cols).value=view.Columns(x).Title
cols=cols+1
End If
End If
Next
maxcols=cols-1
Set doc=view.GetFirstDocument
Set doc2=colls.GetFirstDocument
rows=2
cols=1
Dim inside As Boolean
inside=False
While Not(doc Is Nothing)
For x=0 To Ubound(view.Columns)
excelapplication.statusbar="正在从Notes中引入数据,请稍等.."
fieldname=view.Columns(x).itemname
Set fitem=doc.GetFirstItem(fieldname)
If view.Columns(x).title="文档号" Then '自动生成的文档号处理
excelsheet.Cells(rows,cols).value=rows-1
Else
If Not (fitem Is Nothing) Then
excelsheet.Cells(rows,cols).value=fitem.Text
Else
excelsheet.Cells(rows,cols).value=""
End If
End If
cols=cols+1
Next
rows=rows+1
cols=1
Set doc=view.GetNextdocument(doc)
Wend
excelapplication.statusbar="数据导入完成。"
Set excelapplication=Nothing
End Function