Class for Domino Directory lookups

In many of my Notes programs, I need to perform lookups into the Domino Directory (the database formerly known as Name and Address Book or NAB). So my solution was to create a class that handle those lookups for me, and exposes the most common lookups as separate methods.
We have a slightly modified version of names.nsf, with a few added fields. One of them is what we call ParallelID, which is the user’s ID in a system called (surprise!) Parallel. Since I perform that lookup all the time, I created a separate method for that one called GetParallelID(). Same with manager lookup for a user, I created GetManagerName() for that.
The methods you probably will use the most are GetText() and GetValue().

Since I think this class could come in handy for others, here it is. Enjoy!

Option Public
Option Declare

Class NotesAddressBook
  Private NABdb As NotesDatabase
  Private server As String
  Private nabname As String
  Public silent As Boolean

  Public Sub New(servername As String)
    me.silent = false
    Call LoadNABdb(servername)    
  End Sub

  Public Function GetNABdoc(personname As String) As NotesDocument
    Dim NABview As NotesView
    If NABdb Is Nothing Then
      Call LoadNABdb("")        
    End If
    If Not NABdb Is Nothing Then
      Set NABview = NABdb.GetView("PeopleByFirstname")
      Set GetNABdoc = NABview.GetDocumentByKey(ShortUserName(personname))
    Else
      Set GetNABdoc = Nothing
    End If
  End Function

  Public Function database() As NotesDatabase
    If NABdb Is Nothing Then
      Call LoadNABdb("")        
    End If
    If Not NABdb Is Nothing Then
      Set database = NABdb
    End If
  End Function

  Public Function GetValue(personname As String, fieldname As String) As Variant
    Dim NABdoc As NotesDocument
    Set NABdoc = GetNABdoc(personname)
    If NABdoc Is Nothing Then
      If me.silent = False then
        Msgbox "No document found for '" & personname & "' in " & nabname & " on " & server & ".",,"NotesAddressBook::GetNABdoc()"
      End If
      GetValue = ""
    Else
      GetValue = NABdoc.GetItemValue(fieldname)
    End If
  End Function

  Public Function GetText(personname As String, fieldname As String) As String
    Dim tmp As Variant
    tmp = GetValue(personname, fieldname)
    If IsArray(tmp) Then
      GetText = CStr(tmp(0))
    Else
      GetText = CStr(tmp)
    End If  
  End Function

  Public Function GetName(personname As String, fieldname As String) As NotesName
    Dim tmpValue As String
    tmpValue = GetText(personname, fieldname)
    If tmpValue <> "" Then
      Set GetName = New NotesName(tmpValue)
    End If
  End Function

  Public Function GetNameByParallelID(parallelid As String) As String
    Dim view As NotesView
    Dim doc As NotesDocument 
    Dim tmpValue As String
    Set view = NABdb.GetView("(LookupUserID)")
    Set doc = view.GetDocumentByKey(parallelid)
    If doc Is Nothing Then
      Exit Function
    End If
    tmpValue = doc.GetItemValue("FirstName")(0) & " " 
    If doc.GetItemValue("MiddleInitial")(0)<>"" Then
      tmpValue = tmpValue & doc.GetItemValue("MiddleInitial")(0) & " "
    End If
    tmpValue = tmpValue & doc.GetItemValue("LastName")(0)
    If tmpValue <> "" Then
      GetNameByParallelID = tmpValue
    End If
  End Function  

  Public Function GetCommonName(personname As String, fieldname As String) As String
    Dim tmpName As NotesName
    Set tmpName = GetName(personname, fieldname)
    If Not tmpName Is Nothing Then
      GetCommonName = tmpName.Common
    End If
  End Function

  Public Function GetManagerName(personname As String) As String
    GetManagerName = GetCommonName(personname, "Manager")
  End Function

  Public Function GetParallelID(personname As String) As String
    GetParallelID = GetText(personname, "ParallelID")
  End Function

  Public Function GetBranch(personname As String) As String
    GetBranch = GetText(personname, "Location")
  End Function

  Private Sub LoadNABdb(servername As String)
    Dim session As New NotesSession
    '*** Some users have a local replica of Domino Directory
    '*** but it would never be used unless the code is running
    '*** in a local database, otherwise current server is used. 
    If servername = "" Then
      servername = session.CurrentDatabase.Server
      If servername = "" Then  
        '*** Code running in local database/replica
        server = "Local"
        nabname = "dsnames.nsf"  
      Else
        server = servername
        nabname = "names.nsf"        
      End If
    Else
      server = servername
      nabname = "names.nsf"
    End If
    Set NABdb = session.GetDatabase(servername, nabname)
    If NABdb Is Nothing Then
      Msgbox "Failed to open " & nabname & " on " & server & ".",,"GlobalConfig::New()"
    End If
  End Sub

  Private Function ShortUserName(longname As String) As String
    Dim namearray As Variant

    '*** Remove any periods in name, some users have that
    longname = Replace(longname,".","")

    namearray = Split(longname," ")
    '*** Check if there is middle inital or 3 parts to the name 
    If UBound(namearray) >=2 Then
      '*** check if middle name/initial is just one char (initial)
      If Len(namearray(1))=1 Then
        namearray(1) = ""  ' Remove value
      End If     
    End If
    '*** Join name parts together again and return to calling function
    ShortUserName = FullTrim(Join(namearray))
  End Function

End Class