Export To Excel Current View Using Lotus Script with Visual Bar


Procedure : 
1. Create New Lotus Script Agent with Menu Selection property
2. Copy Below Complete Lotus Script Code and Paste it in Initialize 
3. Save this agent with proper name
4. Close the agent and goto any view in your database
5. Find your agent name in "Action" Menu and run it.
6. Excel File will be ready to desktop.
7. Done.

Const visualproc = True 'Display Visualvisual progress bar true = yes /false = no
Const AppConst = "Excel.Application"
Const AppConst2 = "Excel.Application.8"
Const NPB_TWOLINE% = 1

' Procedures in nnotesws.dll (undocumented!!).

Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim nc, nl, nmore
Dim selList(0 To 20) As String
Dim vcol List As String
Dim excelAppObject As Variant
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 )
Class ProgressBar
' Objects
    Private hwnd As Long
' Constructor.
    Sub New (BarRange As Long)
        On Error Goto ErrorHandler
' Create the visual progress bar.
        Me.hwnd = NEMProgressBegin (NPB_TWOLINE)
' Set the bar range.
        Call NEMProgressSetBarRange (Me.hwnd, BarRange)
        Exit Sub
        Dim TheError As String
        TheError = "Constructor: Error " + Str(Err) + ": " + Error$
        Messagebox TheError, 0 + 48, "visual progress bar Error"
    End Sub
' Use Destructor.
    Sub Delete
' Destroy the visual progress bar.
        Call NEMProgressEnd (Me.hwnd)
    End Sub
    Public Sub UpdatePosition (BarPos As Long)
' Update the bar position.
        Call NEMProgressSetBarPos (Me.hwnd, BarPos)
    End Sub
    Public Sub UpdateProgressText (BarMsg As String, UpdateMsg As String)
' Update progress text.
        Call NEMProgressSetText (Me.hwnd, BarMsg, UpdateMsg)
    End Sub
End Class

Sub Initialize
    On Error Goto ExitExcel
'Main Code starts here
    Dim session As New NotesSession
    Dim workspace As New NotesUIWorkspace
    Dim UIview As NotesUIView
    Dim collection As NotesDocumentCollection  
    Dim coldoc As NotesDocument
    Dim BarMsg As String, UpdateMsg As String
    Dim countall As Long, countthis As Long, countallsel As Long, countthissel As Long
    Dim NChar As String
    Set UIview = workspace.CurrentView
    Set db = session.CurrentDatabase
    UIViewname = UIView.ViewName
    UIViewAlias = UIView.Viewalias
    Set view = db.GetView( UIViewName )
    Set collection = db.UnprocessedDocuments
    gowithselection = False
    goonall = True
    'Determine if it is a collection
    countallsel = collection.count
    If countallsel >1 Then
        gowithselection = workspace.Prompt(PROMPT_YESNO, "Selection found", "Export only selected documents?")
        Set doc=collection.getfirstdocument
        'Check if there is really a doc selected
        If (doc Is Nothing) And (goonwithselection) Then
            Msgbox "Invalid selection"
            Exit Sub
        End If
        Set doc = Nothing
        BarMsg = "Exporting selected documents ..."
        goonall = workspace.Prompt(PROMPT_YESNO, "No Selection found", "Export all documents?" + Chr$(13) + "Info: If you want to export only selected documents," + Chr$(13) + "please select these documents before running this script.")
        If goonall=False Then
            Print "Exiting..."
            Exit Sub
        End If
        Set collection = Nothing
        BarMsg = "Exporting documents ..."
    End If
    doformat = Messagebox("Format the Excel-Sheet?", 36)
    If doFormat = 6 Then
        Call SetSelList()
        SelForm = workspace.Prompt(PROMPT_OKCANCELLIST, "AutoFormat-Form","Select the Autoformat-Form", "Simple" , SelList)
        TitleBar = Cint(Inputbox ( "How many degrees shall the Title-Line be turned", "Title-Turn", "0"))
        If Titlebar > 90 Then
            TitleBar = 90
        Elseif TitleBar < -90 Then
            TitleBar = -90
        End If
    End If
    SelAutoForm = getAutoForm( selForm )
'Launch The Excel and open it in the Quickly on user's machine
    Set excelAppObject = CreateObject( AppConst )
    'Try other AppConst
    If excelAppObject Is Nothing Then
        Set excelAppObject = CreateObject( AppConst2 )
        If excelAppObject Is Nothing Then
            Msgbox "Could not create an Excel Object"
            Exit Sub
        End If
    End If
    excelAppObject.Visible = False
    Call excelAppObject.Workbooks.Add
    Set excelWorksheetObject = excelAppObject.ActiveSheet
'Addition of the table labels
    'do not export hidden columns or those with fixed valus
    Forall c In view.Columns       
        If Not c.ishidden And Not c.IsIcon And Not (c.IsFormula And Not Instr(1, c.Formula, "@") And Not Instr(1, c.Formula, "+")) Then
            nchar = countcol(nChar)
            excelWorksheetObject.Range( nchar + "1").Value = c.Title
        End If
    End Forall
    m_let = nchar
    'Export the Documents
    Set doc = view.GetFirstDocument
    If gowithselection Then countall = countallsel Else countall = view.AllEntries.Count
    countthis = 0
    countthissel = 0
    If visualProc Then Dim RefreshProgress As New ProgressBar (countall) 'Show the Visual ProcessWindow/Bar
    While Not ( doc Is Nothing Or exitnow)
        countthis = countthis + 1
        If gowithselection Then
            Set coldoc = Nothing
            Set coldoc = collection.GetDocument(doc)
            If Not coldoc Is Nothing Then 'Exports only when doc is part of this collection
                Call ExportDoc(excelWorksheetObject)
                countthissel = countthissel + 1
            End If
            If visualproc Then
                UpdateMsg = "Exporting document " + Cstr(countthissel) + " of " + Cstr(countall) + Chr$(13) + "Processing Doc in View: " + Cstr(countthis)             
                Call RefreshProgress.UpdatePosition (countthissel)
                Print "Exporting document " + Cstr(countthissel) + " of " + Cstr(countall) + " / " + "Processing Doc in View: " + Cstr(countthis)
            End If
            Call ExportDoc(excelWorksheetObject)
            UpdateMsg = "Exporting document " + Cstr(countthis) + " of " + Cstr(countall)
            If visualproc Then
                Call RefreshProgress.UpdatePosition (countthis)
                Print UpdateMsg
            End If
        End If
        If visualproc Then Call RefreshProgress.UpdateProgressText (BarMsg, UpdateMsg)
        If countall = countthissel Then exitnow = True  'Exit routine
        Set doc = view.GetNextDocument(doc)
 'formatting the Excel Worksheet
    If doformat = 6 Then
        BarMsg = "One moment please..."
        UpdateMsg = "Formating the document..."
        If visualproc Then Call RefreshProgress.UpdateProgressText (BarMsg, UpdateMsg) Else Print Updatemsg
        excelWorksheetObject.Range("A2:" + m_let + Cstr(nl) ).Select
        excelWorksheetObject.Range("A1:" + m_let + Cstr(nl)).Select
        With excelAppObject.Selection
            .AutoFormat SelAutoForm, False, True, False, True, True, False
            .VerticalAlignment = -4160
        End With
        With excelAppObject.Selection
            .VerticalAlignment = -4107
            .HorizontalAlignment = -4108
            .WrapText = True
            .Orientation = Cint(titlebar)
            .ShrinkToFit = False
            .MergeCells = False
            RowHeight = 215
        End With
        excelWorksheetObject.Range("A:" + m_let).Select
        With excelAppObject.Selection.Font
            .Name = "Arial"
            .Size = 10
        End With
        With excelAppObject.Windows(1)    
        End With 
        With excelWorksheetObject.PageSetup
            .Orientation = 2
            .LeftHeader = "&""Arial,Bold""&18"+db.Title+" - "+ UIViewAlias
            .CenterHeader = ""
            .RightHeader = "Datum: &D"
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = "Seite &P"
            .PrintArea = ("A1:"+ m_let + Cstr(nl))               
            .PaperSize = 9
            .CenterHorizontally = True         
            .FitToPagesTall =False
            .zoom = False
        End With         
    End If
    excelAppObject.Visible = True
    Exit Sub
    Print "Error on Line " + Cstr(Erl) + " : " + Cstr(Error)
    excelAppObject.DisplayAlerts = False
    Exit Sub
End Sub
Function countcol( nChar As String)
    If nc=91 Then
        nmore = nmore+1
    End If
    If nmore > 0 Then
        nchar = Cstr(Chr(nc))  
    End If
    countcol = nchar
End Function
Function getAutoForm( selForm) As Integer
    Select Case SelForm
    Case "Simple"
        SelAutoForm = -4154
    Case "Classic1"
        SelAutoForm =1
    Case "Classic2"
        SelAutoForm =2
    Case "Classic3"
        SelAutoForm =3
    Case "Accounting1"
        SelAutoForm =4
    Case "Accounting2"
        SelAutoForm =5
    Case "Accounting3"
        SelAutoForm =6
    Case "Color1"
        SelAutoForm =7
    Case "Color2"
        SelAutoForm =8
    Case "Color3"      
        SelAutoForm =9
    Case "List1"
        SelAutoForm =10
    Case "List2"
        SelAutoForm =11
    Case "List3"
        SelAutoForm =12
    Case "D3Effects1"
        SelAutoForm =13
    Case "D3Effects2"
        SelAutoForm =14
    Case "Format1"
        SelAutoForm =15
    Case "Format2"
        SelAutoForm =16
    Case "Accounting4"
        SelAutoForm =17
    Case "Format3"
        SelAutoForm =19
    Case "Format4"
        SelAutoForm =20
    Case Else
        SelAutoForm =-4142
    End Select
    GetAutoForm = SelAutoForm  
End Function
Sub SetSelList()
    SelList(0) = "Simple"
    SelList(1) = "Classic1"
    SelList(2) = "Classic2"
    SelList(3) = "Classic3"
    SelList(4) = "Accounting1"
    SelList(5) = "Accounting2"
    SelList(6) = "Accounting3"
    SelList(7) = "Accounting4"
    SelList(8) = "Color1"
    SelList(9) = "Color2"
    SelList(10) = "Color3"
    SelList(11) = "List1"
    SelList(12) = "List2"
    SelList(13) = "List3"
    SelList(14) = "D3Effects1"
    SelList(15) = "D3Effects2"
    SelList(16) = "Format1"
    SelList(17) = "Format2"
    SelList(18) = "Format3"
    SelList(19) = "Format4"
    SelList(20) = "None"   
End Sub
Sub ExportDoc(excelWorksheetObject)
    On Error Goto IfAnyErrorEntry
    Dim nChar As String
    nl= nl+1
    ocount = 0
    Forall c In view.Columns
        If Not c.ishidden And Not c.isicon Then 'Hide hidden columns from export , avoid hidden columns to export!
            nchar = countcol(nChar)
            With excelWorksheetObject.Range(nchar + Cstr(nl))
                .NumberFormat = "@"        
                .Value = doc.ColumnValues(ocount)
            End With
        End If
    End Forall
    Exit Sub
    With excelWorksheetObject.Range(nchar + Cstr(nl))
        .NumberFormat = "@"        
        .Value = "ERROR: WRONG VALUE"
    End With
    Resume Next
End Sub

No comments :