Orange HTC Desire and Tethering

Since buying my Archos 101 Tablet, I have not been able to tether it via wireless, bluetooth or USB to my HTC Desire.  This morning I came across a solution, so I thought I would share it with you.

Import Excel file

Here is some sample code to import a Microsoft Excel file, rather than a CSV file.  I was looking for some sample code to help release the task on the server.

Chrome Extensions

As Xpages is heavily presented using JavaScript, we discovered  that the fastest browser was Google Chrome.  In this article I highlight some of the Extensions that I use to help me with my day to day work with developing web applications and to navigate the web.

Welcome to my new blog !!

Phew!  Finally finished the copying of my blog from Lotus Notes based, into Google.

Months as text

Below is some useful code I have used many times.  This allows you to take a date field and display the month of the field.  I have used this in categorised columns many times for many years.  You have to make sure that if the month number is less than 10 that you prepend a "0", otherwise the month of 11 would become "JanuaryJanuary". 

Get week commencing date

If you want a week commencing date of Monday.... 

Unhide Design

I have a number of templates where a rogue developer has locked the design and has lost the templates (or won't share them). 

There is a solution to unhide the design.

1. Make a local copy of the database
2. Ensure you have manager or designer rights.
3. Open up the .nsf file in a hexadecimal editor.
4. Change address 000000BC from the hexadecimal code 20 to 00.
5. Save the .nsf file. 

This does not seem to work with 8.5.1

Refresh db from the console

This is a command I run very often.  Below is an example to refresh a single database in the EU\CSSD\eSupport directory. 

Server Commands

Thank you Paul Dotter.... 

Sign db

Here is the code to sign a database with LS.

@left in LotusScript

Here is the code

@adjust in LotusScript

Here is the code

@right in LotusScript

Here is the code...

Sort a notessdocumentcollection

Here is the code

@dblookup in LotusScript

Here is the code...

@replaceSubString in Lotusscript

Here is the code

@DBColumn in LotusScript

Function DBColumn (strClass As String, strNoCache As String, strServer As String, strDatabase As String, strView As String, strKey As String) As Variant Dim strFormula As String,quotes As String quotes = Chr(34) strFormula = “@DbColumn(” & quotes & strClass & quotes & “:” & quotes & strNoCache & quotes & “;” & quotes & strServer & quotes & “:” & quotes & strDatabase & quotes & “;” & quotes & strView & quotes & “;” & strKey & “)” DbColumn = Evaluate( strFormula ) End Function

Xpages Cheatsheet

I read this post on PlanetLotus today.  It is a great four page list of Xpages code, which covers all of the common code used when developing. 

If you have not read this, please follow the link below for the article.  I have also added this to my useful documents section. 

Link

Split

Today, thanks to this blog, I have discovered a useful script function called "Split".  I am sure I have used it before, but it escaped my thoughts yesterday when coding the Excel export function.  I know and use Split with JavaScript, but did not remember that it existed in LotusScript. 

Thanks to a comment from Theo Heselmans, my code is now updated and working better than before.  This help and advice is what I love about the Lotus Community.  Thank you.

GetFormattedName function

A simple function I came across going through some old code.

This code accepts a string and turns it into a names field, from which you can send a parameter to get the different types of name, such as Common, Canonical and Abbreviated.

Export Field Revisions to Excel

At home today, due to being snowed in.  I like working from home as it keeps all the banter, telephone calls and meetings to a minimum and when I am coding I like peace and quiet.  I know the developers I work with listen to music, but I don't really like doing that. 

Today I wrote a nice piece of script to export document history to Excel.  The document contains around 14 fields that are stamped when a history snap shot is taken.  These could be dates, text, names and number (no rich text).  The history will be rarely viewed, but when they want to see it, they want to analyse it in Excel.... as always !  

Application to refresh databases

This is an article to discuss a new application that I am working on with some colleagues.  We are all developers and we all know the perils of releasing templates into Production and the pitfalls that can occur.

I am aware of the TeamStudio product called Build Manager, which is a great product, but not all companies are free to spend much money at the moment and so I was tasked to provide another solution.  I am sure there are other tools, and I would be glad to hear from you, if you know such as tool. 

Having brain stormed the idea, it seems as if this is a straight forward LotusScript agent, with some API.  

Android Apps

In recent times, many companies are providing iPhone applications for their customers.  I have an Android phone and thought I would share the list of applications that I use on a daily, if not, weekly basis.  I am interested to hear of other useful applications you use. 

Browser debate

A question : when it comes to providing Xpages solutions, which browser would you choose?  

I have been looking into the browser compatability issues this week and have found a few things that simply do not work in either IE7 and IE8, even if the compatability mode is on.  I then moved to dismiss IE from our supported browser clients, which was a simple decision, however, which browser should I use.

The development team have recently been developing and testing using Chrome.  I like the add-on Extensions, I love the speed and I am happy with the usability.  I have never used firefox, but I understand this is a good browser.  We have noticed that everyting works well in both Chrome and Firefox, so I am happy to announce that we will recommend that our Xpages applications should run in Firefox or Chrome.

Rich Text (Continued...)

We have managed to implement two additional features, which are for adding a URL and adding an in-line image. 

There is a great article in the Developer wiki (http://www-10.lotus.com/ldd/ddwiki.nsf/dx/04022009010354PMWEBMZZ.htm" title="Link" target=_new>Link).  We implemented the xpages method, by adding a file to the server file system and then calling the dojo from the xpage.  It works quite well, however the image has to be uploaded somewhere before you can reference it, you can't just paste in an image.

View to CSV

While writing the previous blog, I thought about another agent that I use quite often.  This agent allows the user to print out a selection of documents from any view, or if there are no selected document, it will output the entire view. 

It is a simple agent, which I just have set to "Run on selected documents".

Download the File.

Find missing databases

When server clusters have not been set up correctly, or you know that two server should have identical database replicas, we as developers often are asked to write a nice piece of Lotusscript to find all the databases on one server and then find the databases that are missing from another.

Second in the World

I read in the news today that Google Android is now ranked as the number two mobile operating system used globally with a 17% share.  Symbian is still the number one with 37%.  This surprised me, even though I am an Android advocate, I feel that I am under constant bombardment from the iPhone users around me.  Even my wife has an iPhone. 

Copy fields from doc to uidoc

I needed to be able to copy fields from a saved document to the document on screen.  This was in our HR system, where we set objectives and KPI's for bonuses.

I made life easy for myself by naming all of the fields that were required for copying "KPI_xxx".  The code below take this into account.

Useful Edit Field Button

Here is some useful code that prompts for a field name, field value and field type.  If the field exists and has a value, it automatically defaults the new value to the existing value.

Delete your Cache with LotusScript

I found this bit of code recently and it saves quite a lot of time by not having to close notes, find the data directory, delete cache.ndk and restart notes. Keep this in a button somewhere (perhaps a draft email) or place it on a database open event. It could also be used to help support users without being at their desk should a TopDesk call arrive at your desk.

Append text to Richtext field

This allows you to post a number of text fields into a single RT field.  We use this to send information from a number of fields in a memo document.

You pass in the RTField, the title you want to display, the fieldname of the contents and the doc.  The result is something along the lines of ...

Convert Document to XML

Here is a small sub that creates an xml file of all the fields available in a document that it is passed.

Simulate Keystokes

From time to time it is often require to perform an operation for the user.  For example, I wanted to exit notes, which I know you can do in other ways, like from the Workspace class, but it was not working in this situation.

Handy Selected Documents Totals

This code snippet take a view, takes the selected documents and adds together a value from a particular field.

Get all dbs on the server

Use the following code to get all dbs on the server and create a document for each with the Title, Path, ReplicaID and Server information.

Sub Initialize
Dim s As New Notessession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim currdb As NotesDatabase

Set currdb = s.currentdatabase
Dim dbdir As New NotesDbDirectory(currdb.Server)
Set db = dbdir.GetFirstDatabase(DATABASE)

While Not(db Is Nothing)
Set doc = currdb.CreateDocument
With doc
.form = "FMain"
.Title = db.Title
.path = db.FilePath
.replicaid = db.ReplicaID
.server = db.Server
End With
Call doc.save(True,True)
Print db.Title, , db.FileName
Set db = dbdir.GetNextDatabase
Wend
End Sub

Make Private folders Public

Sub Click(Source As Button)
       Dim ws As New NotesUIWorkspace
       Dim session As New NotesSession
       Dim db As NotesDatabase
       Dim view As NotesView
       Dim entries As NotesViewEntryCollection
       Dim str_foldername As String

       ' process thru array of views and folders
       Forall folder In session.CurrentDatabase.Views
              ' identify private view/folder
               If Not Isempty(folder.Readers) And folder.IsFolder Then
                       Set entries = folder.AllEntries
                       If entries.Count = 0 Then
                               Call folder.Remove
                       Else
                               str_foldername = folder.Name
                               Call entries.PutAllInFolder(str_foldername &"temp", True)
                               Call folder.Remove
                               Set view = session.CurrentDatabase.GetView(str_foldername & "temp")
                               view.Name = str_foldername
                       End If
               End If
       End Forall
       Messagebox "Private folders have been updated.  Your mail file will now be closed so the changes can take affect.", 64, "Update Complete"
       Call ws.CurrentDatabase.Close
End Sub

Remove text from RichText

SubInitialize()
        Dimsession AsNotesSession
        Dimdb AsNotesDatabase
        Dimdc AsNotesDocumentCollection
        Dimdoc AsNotesDocument
        Dimbody AsNotesRichTextItem
        Dimrtnav AsNotesRichTextNavigator
        Dimrtrange AsNotesRichTextRange
        DimsearchString AsString
        DimrtnavBody AsNotesRichTextNavigator
        DimrtnavPara AsNotesRichTextNavigator
        DimrtrangePara AsNotesRichTextRange
        DimrtrangeRun AsNotesRichTextRange
        DimparaCount AsInteger
        DimrunCount AsInteger
      
        Setsession = NewNotesSession
        Setdb = session.CurrentDatabase
        Setdc = db.UnprocessedDocuments

        Ifdc.Count = 0Then
                MessageBox"No document selected",, "No doc"
                ExitSub
        EndIf

        Setdoc = dc.GetFirstDocument
        Setbody = doc.GetFirstItem("Body")
        Setrtnav = body.CreateNavigator
        Setrtrange = body.CreateRange

        Ifrtnav.FindFirstElement(RTELEM_TYPE_TEXTPARAGRAPH) Then
                SetrtrangePara = body.CreateRange
                SetrtrangeRun = body.CreateRange
                Do
                        paraCount = paraCount + 1
                        runCount = 0
                        CallrtrangePara.SetBegin(rtnav)
                        CallrtrangePara.SetEnd(rtnav)
                        SetrtnavPara = rtrangePara.Navigator
                        REM Get each run in paragraph
                        REM Display it
                        CallrtnavPara.FindFirstElement(RTELEM_TYPE_TEXTRUN)
                        Do
                                runCount = runCount + 1
                                CallrtrangeRun.SetBegin(rtnavPara)
                                'MessageBox rtrangeRun.TextRun,, "Paragraph " & paraCount & ", Run " & runCount
                                CallrtrangeRun.remove
                        LoopWhilertnavPara.FindNextElement(RTELEM_TYPE_TEXTRUN)
                LoopWhilertnav.FindNextElement(RTELEM_TYPE_TEXTPARAGRAPH)
        Else
                MessageBox"No text in Body",,     "No paragraph"
        EndIf

Calldoc.save(True,True)

EndSub

Set Parent field from Child document

Sub Click(Source As Button)
        Dim workspace As New NotesUIWorkspace
        Dim session As New NotesSession
        Dim uidoc As NotesUIDocument
        Dim db As NotesDatabase
        Dim response As NotesDocument
        Dim parent As NotesDocument
        Dim item As NotesItem
        Dim ParentDocumentUNID As String
        Dim strCompleted As String
      
        Set db = session.CurrentDatabase
        Set uidoc = workspace.CurrentDocument
      
        uidoc.EditMode = True
        Call uidoc.Save
      
        strCompleted = uidoc.FieldGetText("Completed")
      
        Set response = uidoc.Document
        ParentDocumentUNID = response.ParentDocumentUNID
        Set parent =  db.GetDocumentByUNID( ParentDocumentUNID )
        parent.EditMode = True
      
        Set item = parent.ReplaceItemValue( "ResponseCompleted", strCompleted )
      
        Call parent.Save( True, False )
        Call uidoc.Close
        Delete uidoc
      
End Sub

Create a connection document

I often have to send out a button with some code to create a connection document in a local nab.  Here is the code.

        Messagebox "This action will automatically add Connection Documents to the <INSERT SERVER NAME> server if they do not already exist in your Personal Address Book.", 0 + 64, "New Connection Documents"
        Dim db As New NotesDatabase("" , "names.nsf")
        Dim view As NotesView
        Dim doc As NotesDocument
        Dim success As Variant
        Dim connect As NotesDocument
        Dim State As Integer
        State = 0
      
        Set view = db.GetView("Connections")
        Set doc = view.GetFirstDocument
        While Not (doc Is Nothing)
                If doc.optionalnetworkaddress(0) = "<INSERT SERVER IP ADDRESS>" Then
                        Goto Alert
                Else
                        Set doc = view.GetNextDocument(doc)
                End If
        Wend
      
        Set connect = db.CreateDocument
        connect.form = "local"
        connect.type = "Connection"
        connect.destination = "<INSERT SERVER NAME>"
        connect.lanportname = "TCPIP"
        connect.connectiontype = "0"
        connect.ConnectionRecordFirst = "Normal"
        connect.optionalnetworkaddress = "<INSERT SERVER IP ADDRESS>"
        success = connect.ComputeWithForm( False, False)
        Call connect.Save(True,True)
        State = State + 1      
      
Alert:
        Select Case State
        Case 0
                Messagebox "Your Personal Address Book already has a Server Connection Document for <INSERT SERVER NAME>; no new connection documents have been created." , 0 + 64 , "Finished!"
        Case 1
                Messagebox "Your Personal Address Book did not have a Server Connection document for <INSERT SERVER NAME>; a new connection document has been created." , 0 + 64, "Finished!"
        End Select

Backup Database

Useful code to backup the current database.  It goes on to the current server, into the current directory, into a subfolder called "backup".  The filename is updated to include the current date.  There is an option to copy the documents, or just the design.

Dim s As New NotesSession
Dim newdb As New NotesDatabase ("", "")
Dim db As NotesDatabase
Dim todaydate As New NotesDateTime ("")
Dim strtodaydate As String
Dim filepath As String
Dim newfilepath As String
Dim filename As String
Dim strmsgbox As String
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim server As String
Dim count As String
Dim doccount As String
Dim title As String


Set db = s.CurrentDatabase
title = db.title
server = db.Server
count = "1"
Set todaydate = New NotesDateTime (Today)
' get the date as a string
strtodaydate = todaydate.Dateonly
' replace all slashes "/" in date formatting
strtodaydate = Replace (strtodaydate,"/","")
filepath = db.filepath
' removes the filename from filepath
filepath = Replace(filepath,db.filename,"")
filename = db.filename
' builds the same filepath as original DB, adding an extra folder level called
newfilepath = filepath + "Backup\" + strtodaydate + "_" + filename
' Ask user if they would like to copy all documents from the database
userprompt = MessageBox ("Do you want to copy all documents from this database?", 4 + 32, "Copy Documents?")
' If user selects yes, copy documents, else do not
If userprompt = 6 Then
' run the backup and copy documents
Set newdb = db.CreateCopy (server, newfilepath)
newdb.title = strtodaydate + " " + title + " Backup"

Set dc = db.AllDocuments
Set doc=dc.GetFirstDocument
doccount = dc.count
While Not doc Is Nothing
Call doc.CopyToDatabase(newdb)
Print "Copying document " + count + " of " + doccount + " documents into " + server + "\" + newfilepath
' add 1 to count
count = count + 1
Set doc=dc.GetNextDocument(doc)
Wend
Else
' run the backup without copy
Set newdb = db.CreateCopy (server, newfilepath)
newdb.title = strtodaydate + " " + title + " Backup"
End If

Get your AD Details

Sample-Code  to retrieve  some Windows-Account-Details via LotusScript.   Thank you to Dietrich Vogel.


Sub Click(Source As Button)
On Error Goto error_handle
Dim objConnection As Variant
Dim objCommand As Variant
Dim objRecordSet  As Variant
Dim NameToSearch As String
Dim SearchScope As String

'   Define the AD Search Scope.   Details depends on the AD-Structure  you're in.
SearchScope = "dc=ad,dc=eu,dc=rf-group,dc=org"


' Get the windows-name  with which you logged on
NameToSearch=Inputbox("Login-Accunt to search: ","Windows Accounts Check", Environ$("username"))

' Create an AD-Connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"

Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection

' Prepare the search String   =>  see our AD-friends for more details; other parameters to retrieve, etc
objCommand.CommandText = _
"<GC://" & SearchScope & ">;" & _
"(&(objectClass=user)" & "(sAMAccountName=" & NameToSearch & "));" & _
"sAMAccountName, distinguishedName, cn, sn,givenName, mail;subtree"

' Execute the search
Set objRecordSet = objCommand.Execute

'  Show the result
If objRecordSet.RecordCount = 0 Then
Msgbox "The sAMAccountName is not in use."
Else
While Not objRecordset.EOF
Msgbox "DistinguishedName = " & objRecordset.Fields("distinguishedName").value, ,"AD Distinguished Name for " & NameToSearch
' Msgbox "sAMAccountName = " &  objRecordset.Fields("sAMAccountName").value
' Msgbox "cn = " & objRecordset.Fields("cn").value
' Msgbox "sn = " & objRecordset.Fields("sn").value
' Msgbox "givenName = " & objRecordset.Fields("givenName").value
Msgbox "MailAddress = " & objRecordset.Fields("mail").value, ,"AD MailAddress  for " & NameToSearch
objRecordset.MoveNext
Wend
End If

' and finish off
ex_sub:
On Error Resume Next
objConnection.Close
Exit Sub

' of course we never get errors.  But    just in case... Show where/wat's wrong   and then ex.
error_handle:
Messagebox "Error in line " & Str(Erl()) & ": " & Error$
Resume ex_sub
End Sub

Remove design flags

On Error Resume Next
Exit sub
Call writeAgentNameToAgentLog ("Remove design flags")
Call logRT.AppendText("Starting Agent")
Call writeToAgentLog (logRT)

Dim s As New NotesSession
Dim db As NotesDatabase
Dim nc As NotesNoteCollection
Dim Flags As Variant
Dim noteid As String
Dim doc As NotesDocument
Dim dbdir As NotesDbDirectory
'Set dbdir =New NotesDbDirectory("CN=EU-WEB-APPS01/OU=Server/O=REMEA-EXT")
Set dbdir =New NotesDbDirectory("CN=UKLON01-Mail01/OU=Server/O=REMEA")

Set db = dbdir.GetFirstDatabase(DATABASE)
Do While Not db Is Nothing
Call db.Open("","")
If (Left(db.Filepath,5)="Mail\") Then
MsgBox "Remove design flags : " & db.title
Set nc = db.CreateNoteCollection(True) ' Select all note types...
nc.SelectDocuments=False ' ...except data documents.
Call nc.BuildCollection

noteid = nc.GetFirstNoteId
Do Until noteid=""
Set doc = db.GetDocumentByID(noteid)
flags = doc.GetItemValue("$Flags")(0)
if (InStr(flags, "P") > 0) Then
flags = Replace(flags, "P", "")
doc.ReplaceItemValue "$Flags", flags
doc.Save True, False, True
MsgBox db.title & ":  Removed P Flag from " & doc.GetItemValue("$Title")(0)
Call logRT.AppendText(db.title & ":  Removed P Flag from " & doc.GetItemValue("$Title")(0) )
Call writeToAgentLog (logRT)
End If
noteid = nc.GetNextNoteId(noteid)
Loop
End If
Set db = dbdir.GetNextDatabase
Loop

Call logRT.AppendText("Finished Archive Agent")
Call writeToAgentLog (logRT)


Exit Sub
ErrorThrower:
Error Err, Error & Chr(13) + "Module: " & CStr( GetThreadInfo(1) ) & ", Line: " & CStr( Erl )
Resume next

Creating ACL spreadsheets with Excel

Have you ever had to create an Excel spreadsheet detailing your ACL, and then had to compare this to the required ACL?

This agent will create a two sheet spreadsheet of the current database ACL, one sheet for the ACL and another containing the roles.


Code

'Declarations
'===============================
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 acl As NotesACL
 Dim entry As NotesACLEntry
 Dim row As Integer
 Dim Col As Integer
 Dim x As Integer
 Dim RoleList List As Integer
 Dim UserTypeList List As String
 Dim AccessLevel List As String
 Set db = s.currentdatabase
 Set acl = db.ACL

 row = 1
 col = 1
 UserTypeList(0) = "Unspecified"
 UserTypeList(1) = "Person"
 UserTypeList(2) = "Server"
 UserTypeList(3) = "Mixed"
 UserTypeList(4) = "Person Group"
 UserTypeList(5) = "Server Group"
 AccessLevel(0) = "No Access"
 AccessLevel(1) = "Depositor"
 AccessLevel(2) = "Reader"
 AccessLevel(3) = "Author"
 AccessLevel(4) = "Editor"
 AccessLevel(5) = "Designer"
 AccessLevel(6) = "Manager"

 '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 = "ACL"
 xlApp.Sheets("Sheet2").Select
 xlApp.Sheets("Sheet2").Name = "Roles"
 xlApp.Sheets("Sheet3").Select
 xlApp.ActiveWindow.SelectedSheets.Delete
 'Set Headings
 xlApp.Sheets("ACL").Select
 xlApp.Cells(Row,6) = "Create"
 xlApp.Cells(Row,7) = "Create"
 xlApp.Cells(Row,8) = "Create"
 xlApp.Cells(Row,9) = "Create"
 xlApp.Cells(Row,10) = "Read"
 xlApp.Cells(Row,11) = "Write"
 row = row + 1
 xlApp.Cells(Row,2) = "User"
 xlApp.Cells(Row,4) = "Create"
 xlApp.Cells(Row,5) = "Delete"
 xlApp.Cells(Row,6) = "Personal"
 xlApp.Cells(Row,7) = "Personal"
 xlApp.Cells(Row,8) = "Shared"
 xlApp.Cells(Row,9) = "LotusScript"
 xlApp.Cells(Row,10) = "Public"
 xlApp.Cells(Row,11) = "Public"
 row = row + 1
 xlApp.Cells(Row,1) = "Name"
 xlApp.Cells(Row,2) = "Type"
 xlApp.Cells(Row,3) = "Access"
 xlApp.Cells(Row,4) = "Documents"
 xlApp.Cells(Row,5) = "Documents"
 xlApp.Cells(Row,6) = "Agents"
 xlApp.Cells(Row,7) = "Folders/Views"
 xlApp.Cells(Row,8) = "Folders/Views"
 xlApp.Cells(Row,9) = "Agents"
 xlApp.Cells(Row,10) = "Documents"
 xlApp.Cells(Row,11) = "Documents"

 ' Now do the roles
 xlApp.Sheets("Roles").Select
 row=1
 xlApp.Cells(Row,2) = "User"
 row = row + 1
 xlApp.Cells(Row,1) = "Name"
 xlApp.Cells(Row,2) = "Type"
 xlApp.Cells(Row,3) = "Access"
 col =3
 x=1
 Forall r In acl.Roles
  col=col+1
  xlApp.Cells(Row,col) = r
  RoleList(r) = x
  x=x+1
 End Forall
 row = 4

 'populate the spreadsheet
 Set entry = acl.GetFirstEntry
 While Not(entry Is Nothing)
  xlApp.Sheets("ACL").Select
  xlApp.Cells(Row,1) = entry.Name
  xlApp.Cells(Row,2) = UserTypeList(entry.UserType)
  xlApp.Cells(Row,3) = AccessLevel(entry.Level)
  If entry.CanCreateDocuments Then xlApp.Cells(Row,4) = "X"
  If entry.CanDeleteDocuments Then xlApp.Cells(Row,5) = "X"
  If entry.CanCreatePersonalAgent Then xlApp.Cells(Row,6) = "X"
  If entry.CanCreatePersonalFolder Then xlApp.Cells(Row,7) = "X"
  If entry.CanCreateSharedFolder Then xlApp.Cells(Row,8) =  "X"
  If entry.CanCreateLSOrJavaAgent Then xlApp.Cells(Row,9) =  "X"
  If entry.IsPublicReader Then xlApp.Cells(Row,10) = "X"
  If entry.IsPublicWriter Then xlApp.Cells(Row,11) = "X"
  xlApp.Sheets("Roles").Select
  xlApp.Cells(Row,1) = entry.Name
  xlApp.Cells(Row,2) = UserTypeList(entry.UserType)
  xlApp.Cells(Row,3) = AccessLevel(entry.Level)
  Forall r In entry.Roles
   If Not(r = "") Then
    col=3+Cint(RoleList(r))
    xlApp.Cells(Row,col) = "X"
   End If
  End Forall
  row = row+1
  Set entry = acl.GetNextEntry(entry)
 Wend

 ' Bold Titles
 xlApp.Sheets("ACL").Select
 For y = 1 To 3
  For z = 1 To 11
   Call GetColumnCode(Cstr(z))
   xlApp.Range(sColumnCode & Cstr(y)).Select
   With xlApp.Selection.Font
    .FontStyle = "Bold"
   End With
  Next
 Next
 xlApp.Sheets("Roles").Select
 For y = 1 To 2
  For z = 1 To x+2
   Call GetColumnCode(Cstr(z))
   xlApp.Range(sColumnCode & Cstr(y)).Select
   With xlApp.Selection.Font
    .FontStyle = "Bold"
   End With
  Next
 Next

 ' autofit the columns in both sheets and underline the titles
 xlApp.Sheets("ACL").Select
 xlApp.Columns("A:K").EntireColumn.AutoFit
 xlApp.Range("A4:K4").Select
 With xlApp.Selection.Borders(xlEdgeTop)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
 End With
 xlApp.Sheets("Roles").Select
 Call GetColumnCode(Cstr(x+2))
 xlApp.Columns("A:" & sColumnCode).EntireColumn.AutoFit
 xlApp.Range("A3:" & sColumnCode & "3").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

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

@explode in LotusScript

21st December 2010 - Update - I would no longer use this code as there is a Split function already to use in LotusScript.
Split(sInput,sDelimiter).

The code below is still useful to know, but I would use the split from no onwards.

Please note I did not write this, but it is useful code to share.


Function LSExplode(ByVal sInput As String, ByVal sDelimiter As String) As Variant
 'LotusScript equivalents for the @Explode
 Dim sOutput As String
 Dim aOutput() As String
 Dim nPos As Integer
 Dim nNextPos As Integer

 sOutput = sInput  
 ReDim aOutput(0)  
 nPos = InStr(sOutput, sDelimiter)
 While nPos <> 0
  aOutput(UBound(aOutput)) = Left(sOutput, nPos - 1)
  sOutput = Right(sOutput, Len(sOutput) - Len(sDelimiter) - nPos + 1)
  nPos = InStr(sOutput, sDelimiter)
  ReDim Preserve aOutput(UBound(aOutput) + 1)
 Wend
 aOutput(UBound(aOutput)) = sOutput  
 LSExplode = aOutput
End Function

Link - HTML lotusscript

Where we are used to read the script with many different colours (such as Blue for Functions and Green for comments), this all fails on the web, just as if we have copied and pasted to Notepad.

I had seen some great examples of code in the past on the CodeStore blog and remember seeing an online tool to convert LotusScript into nice looking html. I found this [[link]] today.

A full blog article has been written for this. [[Lotuscript and HTML]]

Excel Import

Sub Initialize
 Dim session As New NotesSession 
 Dim db As NotesDatabase 
 Dim doc As NotesDocument 
 Dim xlApp As Variant, xlsheet As Variant, xlwb As Variant, xlrange As Variant 
 Dim filename As String, currentvalue As String 
 Dim batchRows As Integer, batchColumns As Integer, totalColumns As Integer 
 Dim x As Integer, y As Integer, startrow As Integer 
 Dim curRow As Long, timer1 As Long, timer2 As Long 
 Dim DataArray, fieldNames, hasData 
 
 timer1=Timer 
 filename="C:\temp\RISEImport.xls" 
 batchRows=200 'process 200 rows at a time 
 
 Set db=session.CurrentDatabase 
 Set xlApp = CreateObject("Excel.Application") 
 xlApp.Visible = True 'set Excel program to run in foreground to see what is happening 
 Set xlwb=xlApp.Workbooks.Open(filename) 
 Set xlsheet =xlwb.Worksheets(1) 
 
 Redim fieldNames(1 To 250) As String 
 
 DataArray=xlsheet.Range("A1").Resize(batchRows, 250).Value 'get worksheet area of specified size 
 
 For y=1 To 250 'we assume max 250 columns in the sheet 
  currentvalue=Cstr(DataArray(1,y)) 
  If currentvalue<>"" Then 'abort counting on empty column 
   fieldNames(y)=currentvalue 'collect field names from the first row 
   totalColumns=y 
  Else 
   y=250 
  End If 
 Next 
 
 Redim Preserve fieldNames(1 To totalColumns) As String 
 
 curRow=2 
 hasData=True 
 While hasData=True 'loop until we get to the end of Excel rows 
  If curRow=2 Then startrow=2 Else startrow=1 
  For x=startrow To batchRows 
   curRow=curRow+1 
   If Cstr(DataArray(x,1))+Cstr(DataArray(x,2))<>"" Then 'when 2 first columns are empty, we assume that it's the end of data 
    Print Cstr(curRow-2) 
    Set doc=New NotesDocument(db) 
    doc.Form="FProc" 
    For y=1 To totalColumns 
     currentvalue=Cstr(DataArray(x,y)) 
     Call doc.ReplaceItemValue(fieldNames(y), currentvalue) 
    Next 
    Call doc.save(True, False) 
   Else 
    hasData=False 
    x=batchRows 
   End If 
  Next 
  If hasData=True Then DataArray=xlsheet.Range("A"+Cstr(curRow)).Resize(batchRows, totalColumns).Value 'get worksheet area 
 Wend 
 timer2=Timer 
 Call xlApp.Quit() 'close Excel program Msgbox "Done in "+Cstr(timer2-timer1)+" seconds" 
End Sub