This is the code:
' Stick it in an action button on a view
' AF Updated 20/8/2002 See above web page for details
' AF Updated 29/10/2002 to autofit column widths
' AF Updated 10/Jan/2003 to allow selection of documents
' AF Updated 24/Feb/2004 to export multivalues useful for date ranges
' See http://www.notesninjas.com/#ExportMultiValsToExcel
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 nvcv As Variant
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
'Check if it is for all documents or only selected
Set othercol = db.unprocesseddocuments
If othercol.count >1 Then 'if more than one doc selected then confirm
resp = Messagebox("Do you want to export only the " & _
"selected " & othercol.count & " documents?", 36, "Selected only?" )
Else
Messagebox "Exporting all rows. (To export only selected " & _
"rows tick those required in the left margin first.)"
End If '6= yes
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
If resp=6 Then 'selected documents
Dim seldoc As notesdocument
Set seldoc = othercol.GetFirstDocument
While Not seldoc Is Nothing
If resp=6 Then
Set otherdoc = otherview.getnextdocument(seldoc)
If otherdoc Is Nothing Then
Set otherdoc = otherview.getprevdocument(seldoc)
If otherdoc Is Nothing Then
Print " >1 doc should be selected"
End
Else
Set otherdoc = otherview.getnextdocument(otherdoc)
End If
Else 'got next doc
Set otherdoc = otherview.getprevdocument(otherdoc)
End If
End If
For colmn = 0 To Ubound(otherview.Columns)
nvcv = otherdoc.columnvalues(colmn)
If Isarray(nvcv) Then
concat = Cstr(nvcv(0) )
For ccnum=1 To Ubound(nvcv)
concat=concat & "-" & Cstr(nvcv(ccnum))
Next ccnum
xlApp.cells(row,colmn+1) = concat
Else
xlApp.cells(row,colmn+1) = Cstr( nvcv )
End If
'xlApp.cells(row,colmn+1) = otherdoc.columnvalues(colmn)
Next
row=row+1
Set seldoc = othercol.GetNextDocument(seldoc)
Wend
Else ' all documents
Set otherdoc = otherview.GetFirstDocument
While Not otherdoc Is Nothing
For colmn = 0 To Ubound(otherview.Columns)
nvcv = otherdoc.columnvalues(colmn)
If Isarray(nvcv) Then
concat = Cstr(nvcv(0) )
For ccnum=1 To Ubound(nvcv)
concat=concat & "-" & Cstr(nvcv(ccnum))
Next ccnum
xlApp.cells(row,colmn+1) = concat
Else
xlApp.cells(row,colmn+1) = Cstr( nvcv )
End If
' xlApp.cells(row,colmn+1) = otherdoc.columnvalues(colmn)
Next
row=row+1
Set otherdoc = otherview.GetNextDocument(otherdoc)
Wend
End If
'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
Please tell me about any problems or suggestions.