Export any view to Excel

Exports all records of any view to Excel

Sub Initialize
      'Create an Excel Spreadsheet from any view
     '11/3/2000 Art Yates
 Dim Session As New NotesSession ,db As NotesDatabase
 Dim sourceview As NotesView,sourcedoc As NotesDocument
 Dim dataview As NotesView, dc As NotesDocumentCollection
 Dim datadoc As NotesDocument, maxcols As Integer
 Dim WS As New Notesuiworkspace
 Dim ViewString As String, Scope As String, GetField As Variant
 Dim C As NotesViewColumn, FieldName 
As String, K As Integer,N As Integer
 Dim xlApp As Variant, xlsheet 
As Variant, rows As Integer, cols As Integer
 Dim nitem As NotesItem , entry 
As NotesViewEntry, vwNav As NotesViewNavigator
 Dim ShowView()  As Variant, i As Integer, 
VList As Variant, ColVals As Variant
  
 Set db = session.CurrentDatabase   'link to current database
 
 'fetch then display a list of views in the database
 Vlist= db.views
 K=Ubound(Vlist)  'get size of list
 Redim Preserve ShowView(K)
 N=-1
 For i = 0 To K
  If Len(Vlist(i).Name) >0 Then 
   FieldName=Trim(Vlist(i).Name)
   If Mid(Fieldname,1,1) <>"(" Then  'do not show hidden views
    N=N+1    
    ShowView(N) = FieldName
   End If
  End If 
 Next i 
 Redim Preserve ShowView(N)
     'now sort the list - by default views are
 listing in the order that they were created
 For i=0 To N
  For K=i To N
   If  ShowView(i) > ShowView(k) Then
    FieldName=ShowView(i) 
    ShowView(i) = ShowView(k)
    ShowView(k)=FieldName
   End If
  Next k
 Next i 
 
 viewstring= ws.Prompt(PROMPT_OKCANCELLIST
,"List of Views","Choose a View","",ShowView )
 If Len(viewstring)=0 Then Exit Sub
 'ViewString ="Dan's View"
 
 Set dataview = db.getview(ViewString)  'get selected view
 
 Set vwnav= dataview.createViewnav()
 
 rows = 1
 cols = 1
 maxcols=dataview.ColumnCount  'how many columns?
 
 Set xlApp = CreateObject("Excel.Application")  
'start Excel with OLE Automation
 xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
 xlApp.Visible = True
 xlApp.Workbooks.Add
 xlApp.ReferenceStyle = 2
 Set xlsheet = xlApp.Workbooks(1).Worksheets(1)  
 'select first worksheet
 
 'worksheet title
 xlsheet.Cells(rows,cols).Value ="View: " + ViewString + 
", from Database: " +  db.title +",  Extract created on: " 
+  Format(Now,"mm/dd/yyyy HH:MM")
 
 xlApp.StatusBar = "Creating Column Heading. 
Please be patient..."
 
 rows=2  'column headings starts in row 2
 For K=1 To maxcols
  Set c=dataview.columns(K-1)
  xlsheet.Cells(rows,cols).Value = c.title
  cols = cols + 1
 Next K
 
 Set entry=vwnav.GetFirstDocument
 rows=3   'data starts in third row
 Do While Not (entry Is Nothing)
  
  For cols=1 To maxcols 
   colvals=entry.ColumnValues(cols-1) 'subscript =0
   scope=Typename(colvals)
   Select Case scope
   Case "STRING"
    xlsheet.Cells(rows,cols).Value ="'" +  colvals
   Case Else 
    xlsheet.Cells(rows,cols).Value = colvals
   End Select   
  Next cols  
  xlApp.StatusBar = "Importing Notes Data   -   
 Document " & rows-1 '& " of " & dc.count & "."  
  rows=rows+1
  Set entry = vwnav.getnextdocument(entry)  
 Loop
 
 xlApp.Rows("1:1").Select
 xlApp.Selection.Font.Bold = True
 xlApp.Selection.Font.Underline = True
 xlApp.Range(xlsheet.Cells(2,1), 
xlsheet.Cells(rows,maxcols)).Select
 xlApp.Selection.Font.Name = "Arial"
 xlApp.Selection.Font.Size = 9
 xlApp.Selection.Columns.AutoFit
 With xlApp.Worksheets(1)
  .PageSetup.Orientation = 2
  .PageSetup.centerheader = "Report - Confidential"
  .Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date: &D"
  .Pagesetup.CenterFooter = ""
 End With
 xlApp.ReferenceStyle = 1
 xlApp.Range("A1").Select
 xlApp.StatusBar = "Importing Data from 
Lotus Notes Application was Completed."
 'xlapp.ActiveWorkbook.saveas "c:VX" +
 Trim(Format(Now,"yyy"))   'save with generated name
 dataview.clear 
 
 Set xlapp=Nothing   'stop OLE
 Set db=Nothing
End Sub

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip library by member Art Yates. Please let others know how useful it is via the rating scale below. Do you have a useful Lotus Notes, Domino, Workplace or WebSphere tip or code snippet to share? Submit it to our monthly tip contest and you could win a prize.