Domino Code Fragment

Code Name*
Check for down servers		Date*
04/29/2024		Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.3.138.174.95
Description*
Checks for Down Servers		Type*
LotusScript		Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Sub Initialize
    Dim servername As Variant
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim x As Integer
    Dim session As New NotesSession    
    Dim dbase2 As NotesDatabase  
   
    servername = session.GetEnvironmentString("MailServer",True)
   
    Dim dbase As New NotesDatabase(servername,"Names.nsf")    
   
    Dim nlog As New NotesLog("Server Responsiveness List")
    Call nlog.OpenMailLog(session.UserName,"Server Check Results")  
   
    Set view = dbase.GetView("Servers")
    Set doc = view.GetFirstDocument
    On Error Resume Next  
    While Not (doc Is Nothing)
         servername = doc.getItemValue("ServerName")
         
         Dim dbasecollection As New NotesDBDirectory(ServerName(0))
         Set dbase2 = dbasecollection.GetFirstDatabase(Database)
         
         If Err <> 0 Then
              Call nlog.LogAction("Unable to Access Server " & _
              servername(0))
              Err = 0
         Else
              Call nlog.LogAction("Server " & servername(0) & _
               " OK")
         End If
         
         Set Doc = view.GetNextDocument(Doc)
    Wend
   
    nlog.Close
    Messagebox("Finished")
End Sub