March 2006 – Weapon of Choice

Microsoft Office products like Word, Excel and Project can be accessed by LotusScript code running on a Windows machine through the OLE interface made available by the CreateObject function:

Dim pjApp As Variant
Set pjApp = CreateObject( "MSProject.Application" )

A handle to an OLE root object is a simple and mighty link to (almost) every property and method of the interfaced application.

Certainly not reachable are the constants, and I cannot guess any reason for this. MS Project 2003 has some 3,800 constants defined. All of them are well described in the online manual, but none of them is ever linked to any of the objects reachable from the root object. They are available from insibe the VBA macros, simply because MSProject is the object library and the VBA runtime generates an object for it. So the constant pjTimescaleDays, which is a member of the enumeration PjTimescaleUnit, is defined by the path

MSProject.PjTimescaleUnit.pjTimescaleDays

In fact VBA programmers are more lucky, because the VBA runtime makes an alias for each constant so that the last identificator is enough.

In my programs I could put Const pjTimescaleDays = 4, it’s just a matter of copy and paste from the Object Browser integrated in the VBA IDE. But this procedure can quickly become annoying, because the whole corpus of help articles and examples heavily rely on the VBA runtime aliasing feature. And if a Notes agent needs access to just a 10% of all of the available constants, then it’s really cumbersome to manually build the 400 lines of constants. And they are constant in a subtle way, i.e. until the product vendor suddenly change them.

To access constants defined in OLE applications the VBA Object Browser uses the Tlbinf32.dll library. Luckily enough this library is just another OLE application which can be directly used in LotusScript code.
It officially ships with Visual Studio, but if you haven’t got it already (it sould be in the windows system32 folder), you can download the Tlbinf32.dll library from afreedll.com.

a good article about the Tlbinf32.dll library
a useful manual for the Tlbinf32.dll library

Example

To show how you can load OLE constants and use them to effectively simplify and make your code selfdocumented, here is a simple agent for importing MS Project tasks into Notes documents.

'Import tasks from MSProject:

Option Public
Option Declare

Use "DoubleLists"
Use "RegistryAccess"

' replace this comment with code in Block 1
' replace this comment with code in Block 2
' replace this comment with code in Block 3

Block 1: How to load OLE constants

Dim pjConst List As Long

Function GetOLEConstant( typeLibInfo As Variant, Byval enumName As String, Byval itemName As String ) As Long
%INCLUDE "error_handling"

    GetOLEConstant = typeLibInfo.TypeInfos.NamedItem( enumName ).GetMember( itemName ).Value

End Function

Sub Load_pjConst
%INCLUDE "error_handling"

    Dim tli As Variant '= Object
    Set tli = CreateObject( "TLI.TLIApplication" )

    Dim MSPRJ_OLB As Variant '= Object
    Set MSPRJ_OLB = tli.TypeLibInfoFromFile( GetPathToMSPRJ_OLB )

    Dim MSO_DLL As Variant '= Object
    Set MSO_DLL = tli.TypeLibInfoFromFile( GetPathToMSO_DLL )

    Dim pjConstLibrary List As Variant '= List As Object
    Set List2( pjConstLibrary, "PjField"            , "pjTaskID" )              = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskName" )            = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskSummary" )         = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskMilestone" )       = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjTimescaleUnit"    , "pjTimescaleDays" )       = MSPRJ_OLB
    Set List2( pjConstLibrary, "MsoDocProperties"   , "msoPropertyTypeString" ) = MSO_DLL

    Forall enumLib In pjConstLibrary

        Dim enumName As String
        enumName = Listtag( enumLib )

        Forall itemLib In enumLib

            Dim itemName As String
            itemName = Listtag( itemLib )

            pjConst( itemName ) = GetOLEConstant( itemLib, enumName, itemName )

        End Forall
    End Forall

End Sub

Block 2: How to find the path to the object libraries

Function GetPathToMSPRJ_OLB
%INCLUDE "error_handling"

    Dim clsid As String
    clsid = RegQueryValue( "HKEY_CLASSES_ROOT", "MSProject.ApplicationCLSID", "" )

    Dim appPath As String
    appPath = RegQueryValue( "HKEY_CLASSES_ROOT", "CLSID" & clsid & "LocalServer32", "" )

    GetPathToMSPRJ_OLB = Strleftback( appPath, "" ) & "MSPRJ.OLB"

End Function

Function GetPathToMSO_DLL
%INCLUDE "error_handling"

    Dim clsid As String
    clsid = RegQueryValue( "HKEY_CLASSES_ROOT", "OfficeCompatible.ApplicationCLSID", "" )

    Dim appPath As String
    appPath = RegQueryValue( "HKEY_CLASSES_ROOT", "CLSID" & clsid & "InprocServer32", "" )

    GetPathToMSO_DLL = appPath

End Function

Block 3: How to import many Project fields at once

Sub Initialize
%INCLUDE "error_handling"

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Set db = s.CurrentDatabase

    Dim pjApp As Variant '= Object
    Set pjApp = CreateObject( "MSProject.Application" )

    Call pjApp.FileOpen( "c:sample.mpp" )
    pjApp.Visible = False

    Dim pjProject As Variant '= Object
    Set pjProject = pjApp.ActiveProject

    Dim pjTaskCollection As Variant '= Object
    Set pjTaskCollection = pjProject.Tasks

    Call Load_pjConst

    Dim fieldIDList List As Long
    fieldIDList( "LineNumber" )   = pjConst( "pjTaskID" )
    fieldIDList( "Title" )        = pjConst( "pjTaskName" )
    fieldIDList( "IsSummary" )    = pjConst( "pjTaskSummary" )
    fieldIDList( "IsMilestone" )  = pjConst( "pjTaskMilestone" )

    Forall pjTask In pjTaskCollection
        If Not( pjTask Is Nothing ) Then
            Dim d As New NotesDocument( db )
            d.Form = "Task"

            Forall fieldID In fieldIDList
                Dim fieldName As String
                fieldName = Listtag( fieldID )
                Dim fieldValue As Variant
                fieldValue = pjTask.GetField( fieldID )
                Call d.ReplaceItemValue( fieldName, fieldValue )
            End Forall

            Call d.Save( True, True, True )
        End If
    End Forall

End Sub

Installing the Tlbinf32.dll library

Before using its services, the Tlbinf32.dll library needs to be properly installed. This is done by putting its file in the windows system32 folder and then by registering it. This means that the user has to have administrator rights to their PC. As usual, you can implement the auto install feature for a needed file in a Notes database in three steps:

Attach the file to the About Database document and hide its paragraph
Add the @Command( [RunAgent]; “(Install Tlbinf32.dll)” ) to the Post Open event of the Database Script
Add the following agent to the database and name it (Install Tlbinf32.dll)

'Install tlbinf32.dll:

Option Public
Option Declare

Use "RegistryAccess"

Sub Initialize
%INCLUDE "error_handling"

    Dim tli As Variant
    On Error Resume Next
    Set tli = CreateObject( "TLI.TLIApplication" )
    On Error Goto HandleError
    If Err = 0 Then
        Set tli = Nothing
        Exit Sub
    End If

    Dim instalar As String
    instalar = "tlbinf32.dll"

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Set db = s.CurrentDatabase

    Dim d As notesdocument
    Set d = GetHelpAboutDocument( db, instalar )
    If d Is Nothing Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be found in the database" & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    Dim systemRoot As String
    systemRoot = RegQueryValue( "HKEY_LOCAL_MACHINE", "SOFTWAREMicrosoftWindows NTCurrentVersion", "SystemRoot" )

    Dim path As String
    path = systemRoot & "system32" & instalar

    Call ExtractAttachment( d, instalar, path )
    If Dir( path ) = "" Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be put in the folder " & path & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    If Shell( "regsvr32 /s " & instalar ) <> 33 Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be registered" & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    Msgbox "The library " & instalar & " has been installed"

    ' HKEY_CLASSES_ROOTCLSID{8B217746-717D-11CE-AB5B-D41203C10000}InprocServer32

End Sub

Function GetHelpAboutDocument( db As NotesDatabase, filename As String ) As NotesDocument
%INCLUDE "error_handling"

    Dim nc As NotesNoteCollection
    Set nc = db.CreateNoteCollection( False )
    nc.SelectHelpAbout = True
    Call nc.BuildCollection
    Dim nid As String
    nid = nc.GetFirstNoteId

    If nid <> "" Then
        Set GetHelpAboutDocument = db.GetDocumentByID( nid )
    Else
        Set GetHelpAboutDocument = Nothing
    End If
End Function

Sub ExtractAttachment( d As NotesDocument, filename As String, path As String )
%INCLUDE "error_handling"

    If Not d.HasEmbedded Then Exit Sub

    Dim embedded As NotesEmbeddedObject
    Set embedded = d.GetAttachment( filename )
    If embedded Is Nothing Then Exit Sub

    Call embedded.ExtractFile( path )
End Sub

I use many lists in my programs. They are handy for keeping it tidy and configurable. I surely could put a constant in its own identificator and sometimes I do. But what if I need two or more similar constants? Lists are definitely the best choice for holding column numbers and for exchanging fields between Office and Notes documents.

Sometimes double lists would be better than normal lists. Example: an agent for importing some fields from an Excel book with many sheets into a Notes document using a double list for declaring the import structure. It should work this way:

Dim xlImport List2 As String
xlImport( "Sheet1", "report" ) = "Title"
xlImport( "Sheet2", "date3" ) = "Date"
xlImport( "Sheet1", "dept" ) = "Department"

With such a structure one could define the import as a simple forall loop:

Dim xlSheet As Variant
Dim xlRange As Variant
Forall f In xlImport
  xlSheet = xlBook.Worksheets( Listtag( f, 1 ) )
  xlRange = xlSheet.Range( Listtag( f, 2 ) )
  Call notesDocument.ReplaceItemValue( f, xlRange.Value )
End Forall

Unfortunately double lists don’t exist in LotusScript, so there is no chance for that code to run in a Notes system.

Here is my implementation of double lists, in its own “DoubleLists” script library. Its use is very similar to the one described earlier, but this is working code.

Dim xlImport List As Variant '= List As String
List2( xlImport, "Sheet1", "report" ) = "Title"
List2( xlImport, "Sheet2", "date3" ) = "Date"
List2( xlImport, "Sheet1", "dept" ) = "Department"

Forall sheet In xlImport
  xlSheet = xlBook.Worksheets( Listtag( sheet ) )
  Forall f In sheet
    xlRange = xlSheet.Range( Listtag( f ) )
    Call notesDocument.ReplaceItemValue( f, xlRange.Value )
  End Forall
End Forall

The important thing here is the flexibility of this approach, something similar to the Prolog programming language. The import machine is known and fixed, but by means of a simple set of declarations it can import any book. And adding a new field to import is just a matter of copy and paste a declaration and adjust it, as well as stopping the import of a field is just a matter of commenting out a declaration. And the program gets self documented. These are the reasons why I use lists and double lists as much as possible.

'DoubleLists:

Option Public
Option Declare

Use "LsConst.lss"

Property Set List2( aList As Variant, tag1 As String, tag2 As String ) As Variant
%INCLUDE "error_handling"

    If Iselement( aList( tag1 ) ) Then
        Dim aux1 As Variant '= List
        aux1 = aList( tag1 )
        Select Case Datatype( List2 )
        Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
            Set aux1( tag2 ) = List2
        Case Else
            aux1( tag2 ) = List2
        End Select
        aList( tag1 ) = aux1
    Else
        Dim aux2 List As Variant
        Select Case Datatype( List2 )
        Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
            Set aux2( tag2 ) = List2
        Case Else
            aux2( tag2 ) = List2
        End Select
        aList( tag1 ) = aux2
    End If
End Property

Property Get List2( aList As Variant, tag1 As String, tag2 As String ) As Variant
%INCLUDE "error_handling"

    If Iselement( aList( tag1 ) ) Then
        Dim aux As Variant
        aux = aList( tag1 )
        If Iselement( aux( tag2 ) ) Then
            Select Case Datatype( aux( tag2 ) )
            Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
                Set List2 = aux( tag2 )
            Case Else
                List2 = aux( tag2 )
            End Select
        Else
            List2 = Null
        End If
    Else
        List2 = Null
    End If
End Property

Month: March 2006

OLE constants

Example

Double Lists