Use Domino objects in VB to retrieve lists

This tip gives you code for a form (.frm - VB 6.0) that retrieves a list of Lotus Notes servers and Lotus Notes databases using Domino objects in Visual Basic.

This Content Component encountered an error

View member feedback to this tip.

This tip gives you code for a form (.frm - VB 6.0) that retrieves a list of Lotus Notes servers and Lotus Notes databases using Domino objects in Visual Basic.

  1. Create a form in Visual Basic.
  2. Open the .frm file with text editor.
  3. Replace the whole code with the code below.

That's all there is too it! You have filled the combo box in Visual Basic with Lotus Notes servers and Lotus Notes databases.

Credit goes to Andy Stevens.

Code:

VERSION 5.00
Begin VB.Form frmNotesTest 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Notes Test"
   ClientHeight    =   2430
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3870
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2430
   ScaleWidth      =   3870
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   495
      Left            =   2520
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.ComboBox cboServers 
      Height          =   315
      ItemData        =  
 "NotesTest.frx":0000
      Left            =   240
      List            =  
 "NotesTest.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   480
      Width           =   3495
   End
   Begin VB.ComboBox cboDatabases 
      Enabled         =   0   'False
      Height          =   315
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   1200
      Width           =   3495
   End
   Begin VB.Label Label1 
      Caption         =   
"Notes Databases:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   960
      Width           =   1815
   End
   Begin VB.Label lblServers 
      Caption         =   "Notes Servers:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1815
   End
End
Attribute VB_Name = "frmNotesTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Declare module level variables
Dim m_objLNSession 
As Domino.NotesSession

Private Sub Form_Load()

    'Create Notes Session
    Set m_objLNSession = 
New Domino.NotesSession
    
    'Replace "Password"
 with your Lotus Notes Account password.
    'If left blank Notes will prompt 
for the password.
    m_objLNSession.Initialize "Password"
    
    'Populate the server combo
    Call PopulateServerCombo
    
End Sub

Private Sub Form_Unload
(Cancel As Integer)

    'Kill the Notes session
    If Not m_objLNSession Is
 Nothing Then
        Set m_objLNSession =
 Nothing
    End If

End Sub

Private Sub cmdExit_Click()

    Unload Me
    
End Sub

Private Sub cboServers_Click()

    If cboServers.ListIndex >= 0
 Then
    
        'Populate the database
 combo
        Call PopulateDBCombo
(cboServers.Text)
    
    End If

End Sub

Private Sub PopulateServerCombo()

'***************************************
******************************
'   Name        :   PopulateServerCombo
'   Purpose     :   Populates the 
Server combo box with Notes Servers
'   Parameters  :   None
'   Returns     :   Nothing
'   Author      :   Andy Stevens
'   Date        :   July 2002
'***************************************
******************************

'Declare local variables
Dim strServers()    As String
Dim intCounter      As Integer

'Declare local constants
Const PROCEDURE_NAME As
 String = 
"frmNotes.PopulateServerCombo"

On Error GoTo ErrorHandler
        
    'Set the mosue pointer
    MousePointer = vbHourglass
        
    'Clear the combo box
    cboServers.Clear
        
    'Retrieve all notes databases
    strServers() = GetNotesServers()
    
    'Populate the combo box with 
Notes databases
    For intCounter = 
LBound(strServers) To UBound(strServers)
        cboServers.AddItem 
strServers(intCounter)
    Next intCounter
    
    'Check we have smoe records
    If cboServers.ListCount > 0 Then
    
        'Select the first record
        cboServers.ListIndex = 0
         
    End If
    
CleanExit:
        
    'Reset the mouse pointer
    MousePointer = vbDefault
        
    Exit Sub

ErrorHandler:

    'Display error
    MsgBox "Error No: " 
& Err.Number & vbCrLf & 
Err.Description & _
           vbCrLf & "Has occured in "
 & PROCEDURE_NAME & vbCrLf & _
           "Please contact technical 
support", vbOKOnly +
 vbCritical, App.Title
           
    Resume CleanExit
    
End Sub

Private Function 
GetNotesServers() As String()

'***********************************
**********************************
'   Name        :   GetNotesServers
'   Purpose     :   Retrieves all Notes
 Servers and places them into
'                   an array
'   Parameters  :   None
'   Returns     :   Array of server 
names
'   Author      :   Andy Stevens
'   Date        :   July 2002
'************************************
*********************************

'Declare local variables
Dim intServerCount  As Integer
Dim strServers()    As String
Dim vntAddressBooks As Variant
Dim intIndex        As Integer
Dim objLNDatabase   
As Domino.NotesDatabase
Dim objLNView       
As Domino.NotesView
Dim objLNDocument   
As Domino.NotesDocument

'Declare local constants
Const FUNCTION_NAME As
 String = "frmNotes.GetNotesServers"

On Error GoTo ErrorHandler
    
    'Initialise the counter
    intServerCount = 0
    
    'Retrieve the address books
    vntAddressBooks = 
m_objLNSession.AddressBooks
        
    'Iterate through the address
 books known to the client
    For intIndex = 0 To 
UBound(vntAddressBooks)
        
        'Get the next address book
        Set objLNDatabase =
 vntAddressBooks(intIndex)
        
        'Check if it's a public 
address book
        If objLNDatabase.
IsPublicAddressBook = True Then
            
            'Open it and look 
for the server list
            objLNDatabase.Open
            
            'Wait for book to open!
            Do While 
Not objLNDatabase.IsOpen
                DoEvents
            Loop
            
            'Retrieve the servers view
            Set objLNView = 
objLNDatabase.GetView("Servers")
            
            'Check we have the view
            If Not objLNView Is Nothing Then
              
                'Get the first document
                Set objLNDocument = 
objLNView.GetFirstDocument
                
                'Iterate through the documents
                Do Until objLNDocument 
Is Nothing
                                        
                    'Size the array
                    ReDim Preserve 
strServers(intServerCount)
                    
                    'Populate the array
                    strServers(intServerCount)
 = objLNDocument.GetItemValue
("ServerName")(0)
                                                            
                    'Get the next document
                    Set objLNDocument = 
objLNView.GetNextDocument(objLNDocument)
                
                    'Increment the counter
                    intServerCount = 
intServerCount + 1
                
                Loop
            
            End If
        
        End If
    
    Next intIndex
    
CleanExit:

    'Kill the document object
    If Not objLNDocument Is Nothing Then
        Set objLNDocument = Nothing
    End If

    'Kill the view object
    If Not objLNView Is Nothing Then
        Set objLNView = Nothing
    End If

    'Kill the database object
    If Not objLNDatabase Is Nothing Then
        Set objLNDatabase = Nothing
    End If
    
    GetNotesServers = strServers()
    
    Exit Function
    
ErrorHandler:

    'Display error
    MsgBox "Error No: " & Err.Number & 
vbCrLf & Err.Description & _
           vbCrLf & "Has occured in " & 
FUNCTION_NAME & vbCrLf & _
           "Please contact technical support"
, vbOKOnly + vbCritical, App.Title
           
    Resume CleanExit
    
End Function

Private Sub PopulateDBCombo
(ByVal v_strServer As String)

'****************************************
*****************************
'   Name        :   PopulateDBCombo
'   Purpose     :   Populates the 
database combo box with databases
'                   on the chosen Notes Server
'   Parameters  :   v_strServer : 
Notes server to search
'   Returns     :   Nothing
'   Author      :   Andy Stevens
'   Date        :   July 2002
'*****************************************
****************************

'Declare local variables
Dim strDatabases()  As String
Dim strArrayItems   As String
Dim intCounter      As Integer

'Declare local constants
Const PROCEDURE_NAME As 
String = "frmNotes.PopulateDBCombo"

On Error GoTo ErrorHandler
        
    'Set the mosue pointer
    MousePointer = vbHourglass
        
    'Clear the combo box
    cboDatabases.Clear
        
    'Retrieve all notes databases
    strDatabases() = 
GetNotesDatabases(v_strServer)
    
    'Concatenate the array
    strArrayItems = Join(strDatabases, "")
    
    'Check for an empty string
    If Not strArrayItems = 
vbNullString Then
       
        'Populate the combo box with 
Notes databases
        For intCounter = LBound(strDatabases)
 To UBound(strDatabases)
            cboDatabases.AddItem 
strDatabases(intCounter)
        Next intCounter
        
    End If
    
    'Check we have smoe records
    If cboDatabases.ListCount > 0 Then
    
        'Enable the database combo
        With cboDatabases
            .Enabled = True
            .ListIndex = 0
        End With
        
    Else
    
        'Disable the database combo
        cboDatabases.Enabled = False
    
    End If
    
CleanExit:
        
    'Reset the mouse pointer
    MousePointer = vbDefault
        
    Exit Sub

ErrorHandler:

    'Display error
    MsgBox "Error No: " & Err.Number &
 vbCrLf & Err.Description & _
           vbCrLf & "Has occured in " & 
PROCEDURE_NAME & vbCrLf & _
           "Please contact technical support",
 vbOKOnly + vbCritical, App.Title
           
    Resume CleanExit
    
End Sub

Private Function GetNotesDatabases
(ByVal v_strServer As String) As String()


'*******************************************
**************************
'   Name        :   GetNotesDatabases
'   Purpose     :   Retrieves all databases
 on a chosen Notes Server
'                   and places them into an array
'   Parameters  :   v_strServer : 
Notes server to search
'   Returns     :   Array of database names
'   Author      :   Andy Stevens
'   Date        :   July 2002
'********************************************
*************************

'Declare local variables
Dim strDatabases()      As String
Dim intDBCount          As Integer
Dim objLNDBDirectory   
 As Domino.NotesDbDirectory
Dim objLNDatabase      
 As Domino.NotesDatabase
Dim strErrorMessage    
 As String
            
'Declare local constants
Const FUNCTION_NAME As String = 
"frmNotes.GetNotesDatabases"

On Error GoTo ErrorHandler
            
    'Initialise the counter
    intDBCount = 0
                        
    'Retrieve the Notes Directory
 for the chosen server
    Set objLNDBDirectory =
 m_objLNSession.GetDbDirectory
(v_strServer)
  
    'Get the first database
    Set objLNDatabase = 
objLNDBDirectory.GetFirstDatabase
(Database)
    
    'Iterate through the databases
    Do While Not objLNDatabase
 Is Nothing
    
        'Size the Array
        ReDim Preserve strDatabases
(intDBCount)
    
        'Populate the array
        strDatabases(intDBCount) = 
objLNDatabase.FilePath
    
        'Get the next db
        Set objLNDatabase = 
objLNDBDirectory.GetNextDatabase
    
        'Increment the counter
        intDBCount = intDBCount + 1
            
    Loop
            
CleanExit:

    'Kill the database object
    If Not objLNDatabase Is Nothing Then
        Set objLNDatabase = Nothing
    End If

    'Kill the directoy object
    If Not objLNDBDirectory Is Nothing Then
        Set objLNDBDirectory = Nothing
    End If
    
    GetNotesDatabases = strDatabases()
    
    Exit Function

ErrorHandler:

    Select Case Err.Number
    
        Case -2147217432
        
            'Server does not exist error, 
do nothing
            
        Case Else
        
            'Display error
            MsgBox "Error No: " & 
Err.Number & vbCrLf & strErrorMessage & _
                   vbCrLf & "Has occured in "
 & FUNCTION_NAME & vbCrLf & _
                   "Please contact technical 
support", vbOKOnly + vbCritical, App.Title
    
    End Select
           
    'No servers found
    'ReDim strDatabases(0)
    'strDatabases(0) = vbNullString
           
    Resume CleanExit
    
End Function

MEMBER FEEDBACK TO THIS TIP

That's not exactly all there is to it. To get this to work, you need to set a reference to Lotus Domino Objects (from the VB IDE, select Project -> References, then check Lotus Domino Objects). Also, change the code in the Form Load event. You need to replace "password" with your Notes password. It would be better to prompt for a password instead. It is a nice bit of code, though.

—Joseph.S.

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip exchange by member Marko Bonaci. Please let others know how useful it is via the rating scale below. Do you have a useful Notes/Domino tip or code to share? Submit it to our monthly tip contest and you could win a prize and a spot in our Hall of Fame.

This was first published in November 2004

Dig deeper on Lotus Notes Domino Database Management

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWinIT

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchVirtualDataCentre.co.UK

Close