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.
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.