' 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