This quick bit of code exports a view to Excel using OLE. Its a major overhaul of code found on Notes.net that, well, didn't really work at all.
When I use it, I create an Export view, that has all the important information from all the documents. That way, since every business requirement for some reason automatically lists "Reporting" as a need (WTF does that mean anyways?) I just let them dump everything to Excel and report all they want to without bothering me! I make it just a raw data dump of all fields out of the document that are important. I even make all the columns with a size of 1. Everything comes out perfectly in Excel. Its absolutely generic. So have fun with it, and let me know of any improvements or ideas you can think of. Now, whenever somebody who thinks they need to do a six sigma on something, you can give them this and get back to playing.
In whatever views you'd like to export, create an action button, make it LotusScript, and then right click in the programmer pane, select Import.
**NEW** Here is a link to a text file that is the below export, only it will allow you to export only selected documents in a view! Please give this a try, and let me know if there are any issues with this code...
-------- Cut Here --------
'R5_Export_to_Excel:
Option Explicit
'Export_R5_Only:
Declare Function NEMGetFile Lib "nnotesws" Alias "NEMGetFile" ( wUnk As Integer, Byval szFileName As String, Byval szFilter As String, Byval szTitle As String ) As Integer
Declare Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As Long
Declare Sub NEMProgressEnd Lib "nnotesws.dll" ( Byval hwnd As Long )
Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwPos As Long)
Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwMax As Long )
Declare Sub NEMProgressSetText Lib "nnotesws.dll" ( Byval hwnd As Long, Byval pcszLine1 As String, Byval pcszLine2 As String )
Const NPB_TWOLINE% = 1 '1 is for the big "in its window" progress bar
Const NPB_NOTEXT%=32 'and 32 is for the small blue line at the bottom of the screen
Const xlAutomatic = -4105
Const xlBottom = -4107
Const xlCategory = 1
Const xlCenter = -4108
Const xlColumnClustered = 51
Const xlContinuous = 1
Const xlDataLabelsShowValue = 2
Const xlDataLabelsShowPercent = 3
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlHairline = 1
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlLandscape = 2
Const xlLeft = -4131
Const xlLine=4
Const xlLineMarkers = 65
Const xlLocationAsObject = 2
Const xlMedium = -4138
Const xlNone = -4142
Const xlPie=5
Const xlPortrait = 1
Const xlRows = 1
Const xlThick = 4
Const xlThin = 2
Const xlTop = -4160
Const xlValue = 2
Sub Click(Source As Button)
'This button will generate an Excel spreadsheet using all data from a view.
Dim szFilter As String
Dim startTime As Single
Dim processingTime As Single
Dim session As New NotesSession
Dim db As NotesDatabase
Dim v As NotesView
Dim ws As New notesuiworkspace
Dim uiview As NotesUIView
Dim docX As NotesDocument
Dim promptlist(4) As String, choice As String
Dim platform As String, view As String
Dim xl As Variant, xlWbk As Variant, xlSheet As Variant, hwnd As Variant, xlsFileName As Variant
Dim row As Integer, col As Integer, numdocs As Integer
On Error Goto errorHandler3
'Check to see if the user is on a MacIntosh
'the "Create Object" function does not run on a Mac
platform = session.Platform
If Not Instr (platform, "MacIntosh") = 0 Then
Messagebox ("This function cannot be run on a MacIntosh. Please use a PC to pull this data into a spreadsheet.")
Exit Sub
End If
promptlist(0)="New Spreadsheet - Display When Completed"
promptlist(1)="New Spreadsheet - Save Directly to Disk"
promptlist(2)="Open Existing Spreadsheet - Display When Completed"
promptlist(3)="Open Existing Spreadsheet - Save Directly to Disk"
choice=ws.prompt(PROMPT_OKCANCELLIST, "Select Action", "Please choose how you would like to perform the export.", promptlist(0), promptlist)
If (choice="") Then
Exit Sub
End If
'Get appropriate file names when required
szFilter = "Excel Spreadsheet|*.xls|All Files|*.*|"
If choice = promptlist(0) Then
Else
xlsFileName = ws.OpenFileDialog (False, "Select Spreadsheet", szFilter)
If xlsFileName(0) ="" Then
Exit Sub
End If
End If
'Set the session variables
startTime = Timer
Set db = session.CurrentDatabase
Set uiview = ws.currentview
Set v = uiview.view
numDocs=v.allentries.count
' Initialise Progress Bar
hwnd = NEMProgressBegin( NPB_TWOLINE ) ' use window style progress bar
NEMProgressSetBarRange hwnd, numDocs ' set range of bar to number of rows
NEMProgressSetText hwnd, "Exporting view to Excel.", "Starting Export to Excel..."
Set xl = CreateObject("Excel.application")
If choice = promptlist(0) Or choice = promptlist(1) Then
Set xlWbk = xl.Workbooks.Add
Else
Set xlWbk = xl.Workbooks.Open(xlsFileName(0))
End If
Set xlSheet = xlWbk.Worksheets(1)
Call xlSheet.Activate
On Error Goto errorHandler
xlSheet.Name = "Notes Exported Data"
xl.Cells.select
xl.Selection.ClearContents
'Start filling in the header column. You can get rid of this if you want to, but then get rid of the section lower that highlights it...
col=1
With xlSheet
Forall vColumn In v.Columns
If vColumn.IsHidden = True Then
Else
.Cells(1, col)=vColumn.Title
col=col+1
End If
End Forall
End With
'Row by Row, Column by Column, fill in the values
Set docX=v.GetFirstDocument
row=2
On Error Goto errorHandler
With xlSheet
While Not docX Is Nothing
col=1
Forall cValue In docX.ColumnValues
.Cells(row, col)=implode(cValue, Chr(10))
continue:
col=col+1
End Forall
row=row+1
If row Mod 10 = 0 Then
processingTime = Timer - startTime
NEMProgressSetBarPos hwnd,row
NemProgressSetText hwnd, "Exporting view to Excel.", "Exporting: "& Cstr(row) & " of " & Cstr(numDocs) & " documents exported in " & Format$(processingTime, "0.00") & " seconds, AVG = " & Format$(row / processingTime , "0.000")
End If
Set docX=v.GetNextDocument(docX)
Wend
End With
On Error Goto errorHandler2
'Set sizing, fonts, etc to make the spreadsheet readable.
xl.Cells.select
xl.selection.Font.Name = "Verdana"
xl.selection.Font.Size = 9
xl.Rows("1:1").Select
xl.Selection.Font.Bold = True
xl.selection.Font.size = 12
xl.selection.RowHeight = 15
xl.Cells.select
xl.selection.columnwidth = 100
xl.selection.columns.Autofit
xl.selection.rows.Autofit
xl.selection.VerticalAlignment = xlTop
xl.ActiveSheet.Range("A1").Select
'Stop Progress Bar
NEMProgressEnd hwnd
'Save and be gone!
On Error Goto errorHandler3
If choice = promptlist(1) Or choice = promptlist(3) Then
Call xlWbk.SaveAs(xlsFileName(0))
Call xlWbk.Close
Messagebox "Export is Complete. You may now open the saved spreadsheet: "&xlsFileName(0)
Call xl.Quit
xl = ""
Else
xl.Visible=True
End If
' LotusScript code...
processingTime = Timer - startTime
Print "The script ran in " & Format$(processingTime, "0.00") & " seconds."
Exit Sub
errorHandler:
'This is called when there is bad data in a notes view, usually text in a date field, etc.
'Notes will show it, but it will fail to export correctly. This replaces the Excel cell with a bad data text.
Resume
errorHandler2:
NEMProgressEnd hwnd
Messagebox "Bad Options setting Spreadsheet format"
Call xl.Quit
xl = ""
Exit Sub
errorHandler3:
NEMProgressEnd hwnd
Messagebox "Bad Filename Specified. Please make sure that the directory name is correct."
Call xl.Quit
xl = ""
Exit Sub
End Sub
Function Implode(Array As Variant,Separator As String) As String
Dim text As String
Dim i As Integer
If Isarray(Array) Then
For i=0 To Ubound(Array)
If i=Ubound(Array) Then
text=text & array(i)
Else
text=text & array(i) & separator
End If
Next
Implode=text
Else
Implode=Array
End If
End Function