OLE constants

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:

1. Attach the file to the About Database document and hide its paragraph
2. Add the @Command( [RunAgent]; “(Install Tlbinf32.dll)” ) to the Post Open event of the Database Script
3. 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