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.
- Create a form in Visual Basic.
- Open the .frm file with text editor.
- 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
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