Solved

Export to Excel

Posted on 2002-03-26
5
577 Views
Last Modified: 2013-12-18
I need an action button to export a view into an excel spreadsheet. Code anyone? Formula or Script. Version 4.6x
0
Comment
Question by:schmad01
5 Comments
 
LVL 10

Expert Comment

by:zvonko
Comment Utility
0
 

Author Comment

by:schmad01
Comment Utility
Will this work for Notes 4.x as well?
0
 
LVL 10

Expert Comment

by:zvonko
Comment Utility
All Notes properties I saw in this agent script are not new in R5.
I do not have any R4.x to test for you.

0
 
LVL 4

Accepted Solution

by:
pratigan earned 50 total points
Comment Utility
This is What I used, tweeked slightly, and it works great.  I placed this code in an agent and then established a hot button to launch the agent.  It really works nice if you create specific views that are going to be exported to excel, that way you can do some preliminary report formatting in the views and then fine tune the output in excel.  Let me know how this works for you .
:)
Paul



'Export to Excel|expexcel:

'Export to Excel v2:

Option Public
%REM
==========================================================================
Export-Script
==========================================================================
This Script has been created by D. Hasa, Yel GmbH, Switzerland  in April 2001

It may be distributed and modified freely, as long as this header is kept intact.

Please report any bugs, fixes or enhancements to info@yel.ch

This script exports a UIView 'As-Is' from Notes 5 to Excel 2000
It has been tested with Notes 5.03/5.05/5.08 into Excel97 & 2000

--> every column (include headers) is a column in Excel
     and every value displayed of a document is a row in Excel
Every Value will be inserted as Text into Excel
==========================================================================
Updates:
==========================================================================
30.11.01
==========================================================================
SELECTED DOCUMENTS
You can now export also only selected documents, but the script gets thru all documents in a view, because the the property doc.ColumnValues(n) only returns a value if it has been fetched from a view (selected documents get fetched by a NotesDocumentCollection).
----
Excel-Object Problems
Added another ExcelApp-Constant (Excel.Application.8)
----
Visualised Progress
This script is From http://www.notes.net/50beta.nsf/7d6a87824e2f09768525655b0050f2f2/1B5AFDF4B4ACC732852566BB005CDC45?OpenDocument
Thanks to Les Szklanny
--> I cannot give you any  guaranty of proper functionality you can turn it on or of --> const visualproc
==========================================================================
Implementation
==========================================================================
It is only a script without any Dialog-Boxes by exception --> Distribution and Implementation is very easy

Simply copy this whole file into an Agent:
Name:    Export to Excel
Run:     Manually from Actions Menu
act on:       Selected documents in View
Run:     Lotus Script

--> Export works in any View/Folder of that database
==========================================================================
%ENDREM


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

Const visualproc = True 'Display VisualProgress true = yes /false = no
Const AppConst = "Excel.Application"
Const AppConst2 = "Excel.Application.8"
Const NPB_TWOLINE% = 1 '1 is for the big "in its window" progress bar and 32 is for the small blue line at the bottom of the screen

' Procedures in nnotesws.dll (undocumented!!).
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 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, "Progress Bar Error"
      End Sub
      
' Destructor.
      Sub Delete
' Destroy the 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
      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 Excel and open it in the UI
      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
      
'Add the table labels
      nc=64
      nmore=0
      Forall c In view.Columns
            'do not export hidden columns or those with fixed vals (not displayed as doc.columnvalues!!!!)
            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 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) 'display the 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 if doc is part of 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
      
      
 'formating the 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 in 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 'PreChar = Axx (AC23)
            nc=65 'reset to A
      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 ErrorEntry
      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 'do not export hidden columns!
                  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
      
ErrorEntry:
      With excelWorksheetObject.Range(nchar + Cstr(nl))
            .NumberFormat = "@"                  
            .Value = "ERROR: WRONG VALUE"
      End With
      Resume Next
End Sub



0
 

Expert Comment

by:SamirKumar
Comment Utility
I have an easy script you can use in R4....Put this in an agent and just replace your field names....

Sub Initialize
     Dim session As New NotesSession
     Dim db As NotesDatabase
     Dim view As NotesView
     Dim dc As NotesDocumentCollection
     Dim Doc As NotesDocument
     
     Dim filename As String
     
     Dim i As Integer
     
     Dim xlApp As Variant
     Dim xlsheet As Variant
     
     Set db = Session.currentdatabase
     Set View = db.GetView( "New Users - Export" )
     Set ws = New NotesUIWorkspace
     
     filename = "C:\temp\temp"
     
     Set xlApp = CreateObject("Excel.application")
     
     xlApp.Visible = True
     
     xlApp.Workbooks.add
     Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
     xlsheet.Activate
     xlsheet.Name = "request4dbammddyyyy"
' Build Header Row for Excel Spreadsheet
     
     
     'ARangeValue = xlsheet.Range("A1").Activate
     'xlsheet.Range("A" & Trim(Str(i + 1))).Value = "Column heading one"
     'xlsheet.Range("B" & Trim(Str(i + 1))).Value = "two"
     'xlsheet.Range("C" & Trim(Str(i + 1))).Value = "three"
     'xlsheet.Range("D" & Trim(Str(i + 1))).Value = "four"
     
' Build Document Collection for Export:
     Set dc = db.UnprocessedDocuments
     
     
' Export Data
     Set Doc = dc.GetFirstDocument
     i=-1
     For c = 1 To dc.count
          i=i+1
          xlsheet.Range("A" & Trim(Str(i + 1))).Value = doc.fieldone(0)
          xlsheet.Range("B" & Trim(Str(i + 1))).Value = doc.fieldtwo(0)
          xlsheet.Range("C" & Trim(Str(i + 1))).Value = doc.fieldthree(0)
          xlsheet.Range("D" & Trim(Str(i + 1))).Value = doc.fieldfour(0)
         
          Set Doc = dc.getnextdocument(Doc)          
     Next
     
     xlApp.Columns("A").Select
     xlApp.Selection.ColumnWidth = 13
     xlApp.Columns("B").Select
     xlApp.Selection.ColumnWidth = 30
     xlApp.Columns("C:D").Select
     xlApp.Selection.ColumnWidth = 15    
End Sub  

Samir
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

You’ve got a lotus Domino web server, and you have been told that “leverage browser caching” is a must do. This means that we have to tell the browser everywhere in the web to use cache. In other words, we set (and send) an expiration date in the HT…
I thought it will be a good idea to make a post as it will help in case someone else faces these issues. I trust this gives an idea how each entry in Notes.ini can mean a lot for the Domino Server to be functioning properly. This article discusses t…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now