< Back

Document Subject: Dump out Categories and totals to Excel
Hint Short Cut: Add this to your code & documentation to help you find this page.
http://#DumpCategoriesAndTotals or http://A555F9/nn.nsf/ByAlias/DumpCategoriesAndTotals

This is very cool code that dumps categories and totals to excel. It works with multiple values in columns too which makes it very useful indeed.




 
' Stick it in an action button on a view
    ' AF 16/Jan/2004 to dump out categories and totals
' See http://www.notesninjas.com/#DumpCategoriesAndTotals


On Error Resume Next  ' < don't like this
Dim s As New notessession
Dim db As notesdatabase
Set db= s.currentdatabase
Dim uiw As New NotesUIWorkspace
Dim otherdoc As NotesDocument
Dim otherview As NotesView
Dim othercol As NotesDocumentCollection


Dim tempdoc As notesdocument

'Work out the current view's name
Dim uiv As notesuiview
Set uiv = uiw.currentview

'if it is R4 then viewalias doesn't work so use
'environment variable stashed in the post open event
If Instr(s.Notesversion, "Release 4") Then
 currentviewname = s.getenvironmentstring("CurrentView")  
 If currentviewname="" Then
  Msgbox "Notes R4, code is not set up properly. Contact developer."
  End
 End If
 Call s.setenvironmentvar("CurrentView","")
Elseif uiv.viewalias <> "" Then 'use alias if it isn't blank
 currentviewname = uiv.viewalias
Else ' use name
 currentviewname = uiv.viewname
End If

   'Get the view
Set otherview = db.GetView(currentviewname)
If otherview Is Nothing Then
 Messagebox "Could not open the view. """ & currentviewname & """"
 Exit Sub
End If

resp=7 ' alldocs

Dim object As NotesEmbeddedObject
Dim xlApp As Variant
Dim oWorkbook As Variant  

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True 'set to visible, this can be moved to the end if you wish

Set oworkbook = xlApp.Workbooks 'handle to Workbook
oworkbook.Add

   'Stick out the column headers
hcolmn=1
Forall c In otherview.Columns
 xlApp.cells(1,hcolmn) = c.title
 hcolmn=hcolmn+1
End Forall  

row=2

' all documents
Dim nav As NotesViewNavigator
Set nav = otherview.CreateViewNav
Set entryA = nav.GetFirst      

Dim nvcv As Variant

While Not entrya Is Nothing   'And row<200
 If entrya.isdocument=False Then
  Print Ubound(entrya.Columnvalues)
  For colmn = 0 To Ubound(entrya.Columnvalues)
   nvcv = entrya.columnvalues(colmn)
   If Isarray(nvcv) Then
    xlApp.cells(row,colmn+1) = Cstr( nvcv(0) )
   Else
    xlApp.cells(row,colmn+1) = Cstr( nvcv )
   End If
  Next  
  row=row+1
 End If 'not a document
 Set entrya = nav.GetNext(entrya)      
 
Wend


'this highlights the headings
xlApp.application.Rows("1:1").Select
With xlApp.application.Selection.Font
 .bold = True
 .ColorIndex = 48
 .Name = "Arial"
 .Size = 12
End With

'this freezes the panes
xlApp.application.Rows("2:2").Select
xlApp.application.ActiveWindow.FreezePanes = True

'this autofits the columns
xlApp.cells.select
xlApp.selection.Columns.AutoFit
xlApp.application.rows("1:1").Select