I have found this code on this site and I was trying to modify it to allow categories to show up in the excel file but I did not succeed. Does any one know how to show the categories in excel?
Sub Click(Source As Button)
On Error Goto ErrorTrap
’ Set up view entities.
Dim ws As New NotesUIWorkspace
Dim uiview As NotesUIView
Dim view As NotesView
Dim viewnav As NotesViewNavigator
Dim viewentry As NotesViewEntry
Dim viewcols As Variant ' view column collection
Dim column As Variant ' view column
Dim iViewCols As Integer ' # of cols in view
Dim iRow As Integer ' counter for XL row
Dim iCol As Integer ' counter for XL col
Dim oApp As Variant ' XL application
Dim XLWS As Variant 'XL worksheet
’ Create the view entities.
Set uiview = ws.currentview
Set view = uiview.view
Set viewnav = view.createviewnav
’ Get the view columns.
viewcols = view.columns
iViewCols = Ubound(viewcols)
’ Now, create XL object.
Set oApp = CreateObject("Excel.Application")
If oApp Is Nothing Then
Msgbox "You do not have Excel installed. Unable to Continue.", 48, "Excel is Required"
Exit Sub
End If
’ Make sure we have a workbook.
oApp.Workbooks.add
’ Use the active sheet.
Set XLWS = oApp.ActiveSheet
'oApp.visible = True
’ Find the view column titles and enter into first row.
For iCol = 0 To iViewCols
XLWS.Cells(1,iCol+1) = viewcols(iCol).title
Next iCol
’ Cycle through the view entries, filling in cells DOES NOT HANDLE Blank (spacer) COLUMNS will bomb
iRow = 2
Set viewentry = viewnav.getfirst
While Not(viewentry Is Nothing)
’ If the view entry is a category, …
If(viewentry.iscategory) Then
For iCol = 0 To iViewCols
'Case not really in use for category - future
Select Case icol
Case 0
oApp.Cells(iRow, iCol + 1) = viewentry.columnvalues(iCol)
Case Else
oApp.Cells(iRow, iCol + 1) = viewentry.columnvalues(iCol)
End Select
Next iCol
Else
’ Fill in the cells, moving over one column at a time.
For iCol = 0 To iViewCols
Select Case icol
Case 0
oApp.Cells(iRow, iCol + 1) = ""
Case 1
oApp.Cells(iRow, iCol + 1) = ""
Case 2
oApp.Cells(iRow, iCol + 1) = ""
Case 3
oApp.Cells(iRow, iCol + 1) = ""
Case Else
oApp.Cells(iRow, iCol + 1) = viewentry.columnvalues(iCol)
End Select
Next iCol
End If
iRow = iRow + 1
Print "Exporting row " & iRow -1
Set viewentry = viewnav.getnext(viewentry)
Wend
’ Select all the cells in the worksheet.
oApp.Cells.Select
’
XLWS.name = "Data Export"
XLWS.Pagesetup.LeftHeader = "&""Arial,Bold""&10&D"
XLWS.Pagesetup.CenterHeader = "&""Arial,Bold""&12Relationship/Revenue Pipeline - Accrual Spreads"
XLWS.Pagesetup.RightHeader = "&""Arial,Bold""&12Spaulding and Slye Colliers"
XLWS.Pagesetup.RightFooter = "&""Arial,Bold""&12Internal Use Only"
XLWS.Pagesetup.CenterFooter = "&P"
XLWS.Pagesetup.Orientation = 2
XLWS.Pagesetup.PaperSize = 5
XLWS.Pagesetup.PrintTitleRows = "$1:$1"
'Select all columns
oApp.columns.select
'Format the cells
oApp.selection.font.name = "Arial"
oApp.selection.font.size = 6
oApp.selection.VerticalAlignment = -4160
'Wrap Columns
'oApp.selection.Wraptext = True
'Resize Columns
'oApp.Cells.EntireColumn.AutoFit
oApp.columns("A:D").Select
oApp.selection.Columnwidth= 1
oApp.columns("E:E").Select
oApp.selection.Columnwidth= 25
oApp.selection.Wraptext = True
oApp.columns("F:F").Select
oApp.selection.Columnwidth= 8
oApp.columns("G:T").Select
oApp.selection.Columnwidth=7
oApp.cells.EntireColumn.NumberFormat= "$#,##0_);[Red]($#,##0)"
'Set all headers bold
oApp.rows("1:1").Select
oApp.selection.Font.Bold = True
oApp.selection.Wraptext = True
oApp.selection.HorizontalAlignment = -4108
'Select Hidden or excess columns to delete
oApp.columns("V:W").Select
oApp.Selection.EntireColumn.Delete
’ Plant ourselves in the first cell.
XLWS.Range("A1").Select
oApp.visible = True
oApp.statusbar = "Export has finished."
’ Give back some memory.
Set oApp = Nothing
Set ws = Nothing
Set uiview = Nothing
Set view = Nothing
Set viewnav = Nothing
Set viewentry = Nothing
Exit Sub
ErrorTrap:
Msgbox "An unexpected error has occurred.",,"Error"
End Sub
Thanks
Alena