Access Notes Mail dynamically via VB 6.0 executable

Create a standard .exe in VB. Add a multi-value list box field, "List1". Add two text fields, "Text1", and "Text2". Make sure the form is named "Form1". Make sure there is an empty label named "Label4", and a command button, "Command1". Beneath the command button, place a frame, call it "Frame2". The caption is also blank. Inside it put another blank label, "Label5". "Label1" should be next to the list box and captioned "Recipient(s)". Label2 should be next to text field Text1 and Captioned "Subject". Label3 should be next to text field Text2 and captioned "Message:". This .exe will access your Notes environment dynamically and will identify your domain, mail file, mail server, and populate a list of everyone in your dom.directory at runtime. Then you can actually send mail from it.

Paste this into General Declaration of the form: Dim s As Object

Then select all and overwrite with this:

Private Sub Command1_Click()
Dim locationDb As Object
Dim locationView As Object
Dim locationDoc As Object
Dim mailDb As Object
Dim mailDoc As Object
Dim currentUser As String
Dim thisLocation As String
Dim mailServer As String
Dim mailFile As String
Set locationDb = s.GetDatabase("", "names.nsf")
Set locationView = locationDb.GetView("Locations")
Set locationDoc = locationView.GetFirstDocument
thisLocation = getLocation()

While Not (locationDoc Is Nothing)
            If locationDoc.GetItemValue("Name")(0) = thisLocation 
Then
                mailServer = getMailServer(locationDoc)
                mailFile = getMailFile(locationDoc)
                Set mailDb = s.GetDatabase(mailServer, mailFile)
            End If
            Set locationDoc = locationView.GetNextDocument
(locationDoc)
Wend
Set mailDoc = mailDb.CreateDocument
Call mailDoc.ReplaceItemValue("SendTo", Form1.List1.Text)
Call mailDoc.ReplaceItemValue("Subject", Form1.Text1.Text)
Call mailDoc.ReplaceItemValue("Body", Form1.Text2.Text)
Call mailDoc.Send(False)
MsgBox "Mail has been sent.", 0 + 64, "Message Sent"
Form1.Text1.Text = ""
Form1.Text2.Text = ""
End Sub

Private Sub Form_Load()
Call Load_Domino
Call Build_Form
End Sub

Public Sub Load_Domino()
Set s = CreateObject("Lotus.NotesSession")
s.Initialize
End Sub
Function getLocation() As String
'get current location and return
currentLocation = s.GetEnvironmentString("Location", True)
myPos = InStr(1, currentLocation, ",", 1)
getLocation = Left(currentLocation, myPos - 1)
End Function
Function getMailServer(locationDoc As Object) As String
getMailServer = locationDoc.GetItemValue("MailServer")(0)
End Function
Function getMailFile(locationDoc As Object) As String
getMailFile = locationDoc.GetItemValue("MailFile")(0)
End Function


Public Sub Build_Form()
Dim namesDb As Object
Dim namesView As Object
Dim nameDoc As Object
Dim locationDb As Object
Dim locationView As Object
Dim locationDoc As Object
Dim mailDb As Object
Dim currentUser As String
Dim thisLocation As String
Dim mailServer As String
Dim mailFile As String
Dim notesDomain As String
Dim myPos As Integer
Dim fileSize As Double

Set locationDb = s.GetDatabase("", "names.nsf")
Set locationView = locationDb.GetView("Locations")
Set locationDoc = locationView.GetFirstDocument
thisLocation = getLocation()

While Not (locationDoc Is Nothing)
            If locationDoc.GetItemValue("Name")(0) = 
thisLocation Then
                notesDomain = locationDoc.GetItemValue
("Domain")(0)
                mailServer = getMailServer(locationDoc)
                mailFile = getMailFile(locationDoc)
                Set mailDb = s.GetDatabase(mailServer, mailFile)
                fileSize = mailDb.Size
            End If
            Set locationDoc = locationView.GetNextDocument
(locationDoc)
Wend

Set namesDb = s.GetDatabase(mailServer, "names.nsf")
Set namesView = namesDb.GetView("people")
Set nameDoc = namesView.GetFirstDocument
currentUser = s.CommonUserName
Form1.Label4.Caption = "Listing of all users in the " & 
notesDomain & " Domain:"
Form1.Frame2.Caption = currentUser & " -- 
Lotus Notes Mail Information"
Form1.Label5.Caption = "Mail Server: " & mailServer & Chr(10) _
& "Mail File: " & mailFile & Chr(10) _
& "Mail File Size: " & CStr(fileSize) & " bytes."

While Not (nameDoc Is Nothing)
If nameDoc.GetItemValue("MiddleInitial")(0) <> "" Then
StrName = nameDoc.GetItemValue("FirstName")(0) & " " & _
          nameDoc.GetItemValue("MiddleInitial")(0) & " " & _
          nameDoc.GetItemValue("LastName")(0)
 Else
   StrName = nameDoc.GetItemValue("FirstName")(0) & " " & _
             nameDoc.GetItemValue("LastName")(0)
End If
Form1.List1.AddItem (StrName)
Set nameDoc = namesView.GetNextDocument(nameDoc)
Wend

End Sub