LOTUS/DOMINO学习笔记之导出到EXCEL的方法

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

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