Export To Excel Current View Using Lotus Script with Visual Bar



THIS AGENT IS USED TO EXPORT THE CURRENT VIEW DATA TO EXCEL-

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.
 
EXPORT TO EXCEL ANY VIEW :


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
       
ErrorHandler:
        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 ..."
    Else
        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
        'SET THE AUTOFORMAT
        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
    nc=64
    nmore=0
    '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
    nl=1
   
    '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
   
    exitnow=False
    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)
            Else
                Print "Exporting document " + Cstr(countthissel) + " of " + Cstr(countall) + " / " + "Processing Doc in View: " + Cstr(countthis)
            End If
        Else
            Call ExportDoc(excelWorksheetObject)
            UpdateMsg = "Exporting document " + Cstr(countthis) + " of " + Cstr(countall)
            If visualproc Then
                Call RefreshProgress.UpdatePosition (countthis)
            Else
                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)
    Wend
   
   
 '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
        excelAppObject.Selection.Columns.AutoFit
        excelWorksheetObject.Range("A1:" + m_let + Cstr(nl)).Select
        With excelAppObject.Selection
            .AutoFormat SelAutoForm, False, True, False, True, True, False
            .VerticalAlignment = -4160
        End With
       
        excelWorksheetObject.Rows("1:1").Select
        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
       
        excelAppObject.Selection.Columns.Autofit
        excelWorksheetObject.Range("A1").Select
       
        With excelAppObject.Windows(1)    
            .SplitRow=1
            .FreezePanes=True
        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
            .FitToPagesWide=1
            .PrintTitleRows=excelWorksheetObject.Rows("1:1").Address
        End With         
    End If
    excelAppObject.Visible = True
    Exit Sub
   
ExitExcel:
    Print "Error on Line " + Cstr(Erl) + " : " + Cstr(Error)
    excelAppObject.DisplayAlerts = False
    excelAppObject.Quit
    Exit Sub
End Sub
Function countcol( nChar As String)
    nc=nc+1
    If nc=91 Then
        nmore = nmore+1
        nc=65
    End If
    If nmore > 0 Then
        nchar=Cstr(Chr(nmore+64))+Cstr(Chr(nc))
    Else
        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
    nc=64
    nmore=0
    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
        ocount=ocount+1
    End Forall
    Exit Sub
   
IfAnyErrorEntry:
    With excelWorksheetObject.Range(nchar + Cstr(nl))
        .NumberFormat = "@"        
        .Value = "ERROR: WRONG VALUE"
    End With
    Resume Next
End Sub


No comments :

Post a Comment

Subscribe to: Post Comments ( Atom )