Option Public
Option Declare
%REM
Copyright (c) 2003  Joe Litton  http://joelitton.net
You are free to use and distribute this code as you wish, provided you do not sell the code, and
provided you do not claim this as your own work.  This is provided as-is, with no guarantees
whatsoever.  Use at your own risk.
==========
This agent exports data from a designated view and writes the data to MS-Excel.
Via the comments, I've attempted to describe how to code this stuff :-)
%END REM

'// The following Excel constants are used for formatting

Const xlAutomatic = -4105
Const xlBottom = -4107
Const xlDownThenOver = 1
Const xlGeneral = 1
Const xlLandscape = 2
Const xlPaperLegal = 5
Const xlPrintNoComments = -4142
Const xlTop = -4160
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlNone = -4142
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlContinuous = 1
Const xlThin = 2
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12

Dim continue As Integer
Dim db As NotesDatabase
Dim dblRead As Double
Dim doc As NotesDocument
Dim Excel As Variant
Dim intNumberOfColumns As Integer
Dim row As Integer
Dim session As NotesSession
Dim strNow As String
Dim strViewName As String
Dim view As NotesView
Dim ws As NotesUIWorkspace
Dim xlFileName As String
Dim xlSheet As Variant
Dim xlVarFileName As Variant
Dim xlWorkbook As Variant

Sub Initialize
  On Error Goto errHandler
  
  strViewName = "People"                '// EDIT THIS LINE to designate the view to read
  intNumberOfColumns = 4                '// Used for the sort function.  Edit to indicate how many columns we export
  
  '// Set up Notes objects
  Set ws = New NotesUIWorkspace
  Set session = New NotesSession
  Set db = session.CurrentDatabase
  Set view = db.GetView( strViewName )
  
  If view Is Nothing Then
    Msgbox |Unable to open view "| & strViewName & |" ...aborting|, 16, |Error during export|
    Exit Sub
  End If
  
  continue = True
  Call startExcel                      '// Call sub to start Excel object
  If Not continue Then
    Call closeItDown                   '// Sub to close Excel
    Exit Sub
  End If
  
  Call writeColumnHeadings
  Call exportData
  If continue Then Call formatOutput   '// Format the worksheet
  Call closeItDown                     '// Call sub to close Excel object
  
  Exit Sub
  
' ==================== ERROR HANDLING ==================== '
errHandler:
  Select Case Err
  '// Any specific errors we want to trap will be listed here; others fall through to the ELSE
  Case Else
    Msgbox "Error " & Str(Err) & ": " & Error$, 16, "Fatal Error...Aborting"
  End Select
  
  '// Ensure that we completely close Excel after an error
  If Not (Excel Is Nothing) Then
    On Error Resume Next
    Excel.Quit
    Set Excel = Nothing
  End If
  
  Exit Sub
  
End Sub
Sub startExcel
  On Error Goto errStartExcel     
  '// Create Excel object, show it, and create new workbook
  
  strNow = Format$( Now, "ddmmmyyyy hhmm" )         '// Get current date/time for use in filename
  
  '// Pop a Windows dialog box to allow them to designate output file location.  We supply
  '// a default filename of the database title followed by current date/time.
  xlVarFileName = ws.OpenFileDialog( False, "Where should the exported Excel file be saved?", _
  "Microsoft Excel Files", "c:\", db.Title & strNow & ".xls" )
  xlFileName = Lcase$( xlVarFileName(0) )
  If Right$( xlFileName, 4) <> ".xls" Then
    Msgbox |You must indicate a filename that ends with ".xls".  Please try the export again.|, 16, "Not an Excel filename format"
    continue = False
    Exit Sub
  End If
  
  Print "Starting MS-Excel..."     
  Set Excel = CreateObject( "Excel.Application" )
  Excel.Visible = False                             '// Hide the Excel window
  Excel.Workbooks.Add                               '// Create a new Excel workbook
  Set xlWorkbook = Excel.ActiveWorkbook             '// Get a handle to the workbook
  Set xlSheet = xlWorkbook.ActiveSheet              '// Get a handle to the worksheet
  
  Exit Sub
  
' ==================== ERROR HANDLING ==================== '
errStartExcel:
  Select Case Err
  Case 184
    '// They clicked <Cancel>, which triggers a "Variant does not contain a container" error.  Just exit.
    continue = False
    Exit Sub
  Case 213
    Msgbox "Please run the export again, this time designating a unique filename", 64, "Filename already exists"
    continue = False
    Resume Next
  Case Else
    Msgbox "Error " & Str(Err) & ": " & Error$, 16, "Fatal Error...Aborting"
    continue = False
  End Select
  
  Exit Sub
  
End Sub
Sub writeColumnHeadings
  
  Print "Writing column headings..."
  xlSheet.Cells( 1, 1 ).Value = "Name"
  xlSheet.Cells( 1, 2 ).Value = "Email"
  xlSheet.Cells( 1, 3 ).Value = "Phone(s)"
  xlSheet.Cells( 1, 4 ).Value = "Business"
  
End Sub
Sub exportData
  On Error Goto errExportData
  
  '// Cycle through the view, exporting data to Excel.  Bear in mind that here we export what
  '// is shown in the view columns for some data, and the actual data from the document for other.  row = 1
  Set doc = view.GetFirstDocument
  row = 1
  Do While Not (doc Is Nothing)
    dblRead = dblRead + 1
    Print "Docs read: " & Cstr(dblRead) & "..."
    row = row + 1
    '// The row, of course, is incremented each time so that we write a fresh row with each doc.
    xlSheet.Cells( row, 1 ).Value = doc.ColumnValues(0)
    xlSheet.Cells( row, 2 ).Value = doc.ColumnValues(1)
    xlSheet.Cells( row, 3 ).Value = doc.OfficePhoneNumber(0)
    xlSheet.Cells( row, 4 ).Value = doc.ColumnValues(3)
getNextDoc:
    Set doc = view.GetNextDocument( doc )
  Loop
  
  Exit Sub
  
' ==================== ERROR HANDLING ==================== '
errExportData:
  Select Case Err
  Case 1024
    '// 'Operation failed'.  This is the error if we're running on a local replica and a document (like Group Calendar)
    '// wants to access a remote server.  Just skip to the next doc.
    Resume getNextDoc
  Case Else
    Msgbox "Error " & Str(Err) & ": " & Error$, 16, "Fatal Error...Aborting"
    continue = False
  End Select
  
  Exit Sub
  
End Sub
Sub formatOutput
%REM
  There are a couple of spots in this sub to edit.  The first spot is the series of code paragraphs
that set the width for each column.  Read the comments at the top of the section, remembering
to add a paragraph for each column (if you want to specify the width).
  The second spot is the final block of code that adds cell borders for nicer printing.  Edit the
2nd letter in each of the range designations to correspond to the number of columns you
are exporting (1st column is "A", 2nd column is "B", etc.).
%END REM
  
  Print "Formatting spreadsheet; please wait..."
  
  With xlSheet.Cells
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlTop
    .WrapText = False
    .Orientation = 0
    .ShrinkToFit = True
    .MergeCells = False
    .EntireColumn.AutoFit
  End With
  
  '// Select the first row (the column headings) and set to 8pt bold
  xlSheet.Rows(1).Select
  With xlSheet.Rows(1).Font
    .Bold = True
    .Name = "Arial"
    .Size = 8
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
  End With
  
  '// Set width for each column.  "A:A" is column 1, "B:B" is column 2, etc. Run the export once
  '// without worrying about the column widths.  Then massage the output file to have the widths
  '// you want for the columns and adjust the values here to match.
  xlSheet.Columns("A:A").Select
  With xlSheet.Columns("A:A")
    .WrapText = True
    .ColumnWidth = 20
  End With
  
  xlSheet.Columns("B:B").Select
  With xlSheet.Columns("B:B")
    .WrapText = True
    .ColumnWidth = 30
  End With
  
  xlSheet.Columns("C:C").Select
  With xlSheet.Columns("C:C")
    .WrapText = True
    .ColumnWidth = 30
  End With
  
  xlSheet.Columns("D:D").Select
  With xlSheet.Columns("D:D")
    .WrapText = True
    .ColumnWidth = 30
  End With
  
  '// Sort on the first col.
  xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(row, intNumberOfColumns)).SortSpecial
  
  '// Set print options.  This code will add a header and footer to the hardcopy and set the orientation
  '// to Landscape, printing on Legal size paper.  Edit for your preferences, of course.
  With xlSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
  End With
  xlSheet.PageSetup.PrintArea = ""
  With xlSheet.PageSetup
    .LeftHeader = _
    db.Title & " - " & strViewName
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = "&F"
    .CenterFooter = "&P"
    .RightFooter = "&D"
    .LeftMargin = Excel.InchesToPoints(0.75)
    .RightMargin = Excel.InchesToPoints(0.75)
    .TopMargin = Excel.InchesToPoints(1)
    .BottomMargin = Excel.InchesToPoints(1)
    .HeaderMargin = Excel.InchesToPoints(0.5)
    .FooterMargin = Excel.InchesToPoints(0.5)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperLegal
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 100
  End With
  
  '// Add cell borders for printing
  xlSheet.Range("A1:D" & row).Select
  xlSheet.Range("A1:D" & row).Borders(xlDiagonalDown).LineStyle = xlNone
  xlSheet.Range("A1:D" & row).Borders(xlDiagonalUp).LineStyle = xlNone
  With xlSheet.Range("A1:D" & row).Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With xlSheet.Range("A1:D" & row).Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With xlSheet.Range("A1:D" & row).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With xlSheet.Range("A1:D" & row).Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With xlSheet.Range("A1:D" & row).Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  With xlSheet.Range("A1:D" & row).Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  xlSheet.Range("A1").Select                 '// Select home cell before exiting
  
End Sub
Sub closeItDown
  
  '// Shut it down; we're done.
  Print "Saving spreadsheet and closing MS-Excel..."
  xlWorkbook.Close True, xlFileName          '// Close the Excel file, saving it to the designated location
  Excel.Quit                                 '// Close Excel
  Set Excel = Nothing                        '// Free the memory that we'd used
  Print " "                                  '// Clear the status line
  
  '// Display DONE message with info icon
  Msgbox Cstr(row) & " rows were exported to " & xlFileName & ".", 64, "Export DONE"
  
End Sub