传递要导出的视图名和工作表名

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