Export Field Revisions to Excel

Option Public
Option Declare

Dim xlApp As Variant
Dim xlWkBook As Variant
Dim sColumnCode As String
Const xlDiagonalDown=5
Const xlNone=-4142
Const xlDiagonalUp=6
Const xlEdgeBottom=9
Const xlEdgeLeft=7
Const xlEdgeRight=10
Const xlEdgeTop=8
Const xlAutomatic=-4105
Const xlContinuous=1
Const xlThin=2
Const xlInsideVertical=11
Const xlUnderlineStyleNone=-4142
Const xlPrintNoComments=-4142
Const xlLandscape=2
Const xlPaperA4=9
Const xlDownThenOver=1

Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim row As Integer
Dim Col As Integer
Dim x, maxcols, maxrows As Integer
Set db = s.currentdatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim HistoryItems As Variant

'Get a handle on the selected documents
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument

If doc Is Nothing Then
exit Sub
End If

'Create Spreadsheet titles
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWkBook = xlApp.Workbooks
xlWkBook.Add
xlApp.Application.DisplayAlerts = False
xlApp.Sheets("Sheet1").Select
xlApp.Sheets("Sheet1").Name = "Document History"
xlApp.Sheets("Sheet2").Select
xlApp.ActiveWindow.SelectedSheets.Delete
xlApp.Sheets("Sheet3").Select
xlApp.ActiveWindow.SelectedSheets.Delete
xlApp.Sheets("Document History").Select
row = 2

'While Not doc Is Nothing
ForAll hist In doc.revisionHistory
HistoryItems = Split(hist,"~")
col = 1
ForAll item In HistoryItems
xlApp.Cells(Row,col) = item
col = col + 1
End ForAll  
row = row + 1
End ForAll

maxcols = col
maxrows = row-1
'Set Headings
row = 1
For x = 1 To maxcols
xlApp.Cells(Row,x) = "Title"
Next


' Bold Titles
For x = 1 To maxcols
Call GetColumnCode(CStr(x))
xlApp.Range(sColumnCode & "1").Select
With xlApp.Selection.Font
.FontStyle = "Bold"
End With
Next


' autofit the columns in both sheets and underline the titles
Call GetColumnCode(CStr(maxcols))
xlApp.Columns("A:" & sColumnCode).EntireColumn.AutoFit
xlApp.Range("A2" & ":" & sColumnCode & "2" ).Select
With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End Sub


Sub GetColumnCode(sColumnNumber As String)
 Select Case sColumnNumber
 Case "1"
  sColumnCode = "A"
 Case "2"
  sColumnCode = "B"
 Case "3"
  sColumnCode = "C"
 Case "4"
  sColumnCode = "D"
 Case "5"
  sColumnCode = "E"
 Case "6"
  sColumnCode = "F"
 Case "7"
  sColumnCode = "G"
 Case "8"
  sColumnCode = "H"
 Case "9"
  sColumnCode = "I"
 Case "10"
  sColumnCode = "J"
 Case "11"
  sColumnCode = "K"
 Case "12"
  sColumnCode = "L"
 Case "13"
  sColumnCode = "M"
 Case "14"
  sColumnCode = "N"
 Case "15"
  sColumnCode = "O"
 Case "16"
  sColumnCode = "P"
 Case "17"
  sColumnCode = "Q"
 Case "18"
  sColumnCode = "R"
 Case "19"
  sColumnCode = "S"
 Case "20"
  sColumnCode = "T"
 Case "21"
  sColumnCode = "U"
 Case "22"
  sColumnCode = "V"
 Case "23"
  sColumnCode = "W"
 Case "24"
  sColumnCode = "X"
 Case "25"
  sColumnCode = "Y"
 Case "26"
  sColumnCode = "Z"
 Case "27"
  sColumnCode = "AA"
 Case "28"
  sColumnCode = "AB"
 Case "29"
  sColumnCode = "AC"
 Case "30"
  sColumnCode = "AD"
 Case "31"
  sColumnCode = "AE"
 Case "32"
  sColumnCode = "AF"
 Case "33"
  sColumnCode = "AG"
 Case "34"
  sColumnCode = "AH"
 Case "35"
  sColumnCode = "AI"
 Case "36"
  sColumnCode = "AJ"
 Case "37"
  sColumnCode = "AK"
 Case "38"
  sColumnCode = "AL"
 Case "39"
  sColumnCode = "AM"
 Case "40"
  sColumnCode = "AN"
 Case "41"
  sColumnCode = "AO"
 Case "42"
  sColumnCode = "AP"
 Case "43"
  sColumnCode = "AQ"
 Case "44"
  sColumnCode = "AR"
 Case "45"
  sColumnCode = "AS"
 Case "46"
  sColumnCode = "AT"
 Case "47"
  sColumnCode = "AU"
 Case "48"
  sColumnCode = "AV"
 Case "49"
  sColumnCode = "AW"
 Case "50"
  sColumnCode = "AX"
 Case "51"
  sColumnCode = "AY"
 Case "52"
  sColumnCode = "AZ"
 End Select
 End sub