I have this agent that checks the acl’s for databases listed in a config document. The agent finds the config document and then tries to open each database listed in the config document field named “OtherDomDbs”. Now, for some of the databases, the user may not have the rights to access so an error 4060 is thrown out as expected. There is an error trap that takes this into consideration and then the next database is opened for examination and the the process continues through the array of databases.
The issue is when a second database is attempted to be accessed and the user does not have the rights to access the database then the error is not thrown into the error trap but is pushed out of the sub into the error trap of the calling Sub and then the process is stopped. Does anyone have ideas as to why this happens
Server is 602 CF1
Clients are 603
Sample of code:
'/////////////////////////////////////////////////////////////////////////////////
Declarations
Dim thisDb As NotesDatabase
Dim thisAgent As NotesAgent
Dim DbACLDoc As NotesDocument
Dim logDoc As NotesDocument
Dim db As NotesDatabase
Dim Count As Integer
Dim OpenCount As Integer
Dim UnOpenCount As Integer
Dim Server As String, startTime As Variant
Dim body As notesrichtextitem
Dim failedDbs As String
Dim Servers As String
Dim indDbs As String
Dim LogBody As NotesRichTextItemerrNbr As Integer
Dim DBsInQuestion As String
'/////////////////////////////////////////////////////////////////////////////////
Sub Initialize
Call GetConfigDocuments
End Sub
'/////////////////////////////////////////////////////////////////////////////////
Sub GetConfigDocuments()
'Print thisAgent.Name + ""
On Error Goto ErrorTrap
Dim s As New NotesSession
Dim cfgVu As NotesView
Dim dc As NotesDocumentCollection
Dim cfgDoc As NotesDocument
Dim item As NotesItem
Set cfgVu = thisDb.GetView("luconfig")
Set dc = cfgVu.getAllDocumentsByKey("ServerConfig",True)
Set cfgDoc = dc.getfirstDocument
Do Until cfgDoc Is Nothing
'set the serverName we are trying to get the ACL info from
Server$ =cfgDoc.ServerName(0)
'get NAB for local server
Dim NABDb As NotesDatabase
Dim NABvu As NotesView
Dim NabDoc As NotesDocument
Dim NabItem As NotesItem
If s.IsOnServer = True Then 'do not need to enter servername
Set NABDb = s.GetDatabase("","names.nsf",False)
Set Nabvu = NabDb.GetView("Groups")
Else 'need to enter server name
Set NABDb = s.GetDatabase(Server$,"names.nsf",False)
Set Nabvu = NabDb.GetView("Groups")
End If
If Servers = "" Then
Servers = Server$
Else
Servers = servers + ";" + Server$
End If
If cfgDoc.YesNo(0) = "Yes" Then 'running agent on all files in the database
Call RunAgentOnAllDBs(Int(cfgDoc.FileType(0)))
Else
Set item = cfgDoc.GetFirstItem("OtherDomDBs")
Call RunAgentOnCertainDbs(item)
End If
NextCFG:
Set cfgDoc =dc.getNextDocument(cfgDoc)
If errNbr = 4072 Then
Set emailDoc = thisDb.CreateDocument
emaildoc.subject = "ACL Check Error: Server does not exist!"
newMsg= "Unable to access the server " + Server$ +". Please check the configuration
document for this server." _
& Chr(10) +Chr(10) & "The issue may be that the server is down or the server is not listed
properly on the document."
errNbr = 0
Else
newMsg=item.Values(0)+ Chr(10) + Chr(10) + "Databases with issues:" +Chr(10) + DBsInQuestion
End If
Loop
Goto EndOfCode
ErrorTrap:
Stop
If Err = 4060 Then
varErr = 4060
Call RunAgentOnCertainDbs(item)
End If
If Not DbACLDoc Is Nothing Then
DbACLDoc.LogTitle = thisAgent.Name
Set DocAuthors = New NotesItem(DbACLDoc, "Authors", "", AUTHORS)
Call DbACLDoc.Save(True,False) 'fail Safe Save
End If
Resume Next
EndOfCode:
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////
Sub RunAgentOnCertainDBs(Dbs As Notesitem)
Dim s As New NotesSession
Dim agentServerName As NotesName
Dim DBStr As String
Dim Item As NotesItem
If varErr = 4060 Then 'looks like for some reason this errored out before we could finish all dbs process
need to pick up where we left off.
varErr = 0 'set back to zero
DbACLDoc.Status = "Error" & Str(Err) & ": " & Error$
Call DbACLDoc.Save(True,False)
'reset the variables to what they where before we errored out or advance them for proper processing.
arrayCount = arrayCount + 1 'get tot he next dbs value
n% = arrayCount
count = count+1
UnOpenCount = UnOpenCount + 1
If unopencount = 1 Then
failedDbs = Server$ + "\\"+ a
Else
failedDbs = failedDbs + "; " + Server$ + "\\"+a
End If
Goto StartLoop 'bypass the intialize stuff
End If
'initialize stuff
arrayCount = 0
dbsInQuestion = ""
StartLoop:
Set agentServerName= New NotesName(thisAgent.ServerName)
If AgentServerName.common = Server$ And s.IsOnServer = True Then Server$ = "" 'the server is local to the
agent so we don’t need the server name in the code
For j% = n% To Ubound(Dbs.Values)
On Error Goto NoAccessToDB
a = Dbs.values(j%)
DBStr = a
'set up a DbACL document to record captured data to
Set DbACLDoc = thisDb.CreateDocument()
DbACLDoc.Form = "DbACL"
DbACLDoc.DateCreated = startTime
DbACLDoc.LogTitle = thisAgent.Name
DBACLDoc.FilePath = dbstr
DBACLDoc.DbTitle = dbstr 'will be overwritten later if connection ios successful
Set DocAuthors = New NotesItem(DbACLDoc, "Authors", "", AUTHORS)
Call DocAuthors.AppendToTextList("[ACL CHECK]") 'set fo0r secutity reasons
Set body = DbACLDoc.CreateRichTextItem( "Body" )
If Server$ = "" Then
DbACLDoc.Server = AgentServerName.common
Else
DbACLDoc.Server = Server$
End If
Call DbACLDoc.Save(True,False)
Set db = s.GetDatabase(Server$,a,False)
'need to log if database actually does not exist.
If db Is Nothing Then 'append to log that this is a bogus database
statusStr = "Database """+ a + """ does not exist on the server """ + Server$ +""". Check
that the filepath and name of the database is typed correctly in the server configuration document which this
database is listed."
LogBody.AddNewline(1)
LogBody.AppendText(statusStr)
dbACLDoc.Status = statusStr
Goto CantOpenDb
End If
While Not DB Is Nothing
'process databases
entryNbr = 0 ' initializes the ACL entry count
UnspecifiedNames = "" 'initialize unspecified
IndividualNames = "" 'initialize Individual
DbACLDoc.filePath = db.FilePath
DbACLDoc.DBTitle = Db.Title
Call DbACLDoc.Save(True,False)
If Not db.IsOpen Then
Call db.open("","")
End If
If db.IsOpen Then
'Do some Processing here
DbACLDoc.SuccessNbr = 1 'used for filtering out for views and reports
Set item = DbACLDoc.ReplaceItemValue("Unspecifieds",UnspecifiedNames)
Set item = DbACLDoc.ReplaceItemValue("Individuals",PersonNames)
Call DbACLDoc.Save(True,False)
Else
CantOpenDb:
’ statusStr = “Database “””+ a + “”" does not exist on the server “”" + Server$ +“”".
Check that the filepath and name of the database is typed correctly in the server configuration document which this
database is listed."
DbACLDoc.SuccessNbr = 0 'used for filtering out for views and reports
UnOpenCount = UnOpenCount + 1 'helps with devbugging
If unopencount = 1 Then
failedDbs = Server$ + "\\"+ a
Else
failedDbs = failedDbs + "; " + Server$ + "\\"+a
End If
Goto NextDB
End If
Call DbACLDoc.Save(True,False)
NextDB:
count = count+1 'helps with debugging
arrayCount = ArrayCount + 1
entryNbr = 0 'reinitialize for next database
Set db = Nothing
Wend
Goto EndOfCode
NoAccessToDB:
If Err = 4060 Then 'cannot open db
errNbr = Err
LogBody.AddNewline(1)
' LogBody.AppendText( Cstr(errNbr) + " - " + Server$ +"\\" + a + ": cannot open db " )
LogBody.AppendText( Str(Err) & ": " & Error$ )
DbACLDoc.Status = "Error" & Str(Err) & ": " & Error$
Err = 0
Goto CantOpenDb
End If
If Err = 4072 Then 'server does not exist
errNbr = Err
LogBody.AddNewline(1)
LogBody.AppendText( Cstr(errNbr) + " - " + Server$ + ": Server does not exist")
Goto endOfCode
End If
'set some fields on the DBACL doc recording error
DbACLDoc.Status = "Error - RAOCD " & "Error" & Str(Err) & ": " & Error$
Body.AddNewline(1)
Body.AppendText("The following error message was recieved at line number " & Erl() &"." & Chr(10) &
“Error” & Str(Err) & ": " & Error$)
Call DbACLDoc.Save(True,False)
LogBody.AddNewline(1)
LogBody.AppendText("The following error message was recieved at line number " & Erl() &"." & Chr(10)
& “Error” & Str(Err) & ": " & Error$)
Call logDoc.Save(True,False)
Resume Next
EndOfCode:
’ End Forall
Next
End Sub
'/////////////////////////////////////////////////////////////////////////////////////////////////
Sub RunAgentOnAllDBs(FileType%)
On Error Goto NoAccessToDB
Dim s As New NotesSession
Dim agentServerName As NotesName
Set agentServerName= New NotesName(thisAgent.ServerName)
If AgentServerName.common = Server$ And s.IsOnServer = True Then Server$ = "" 'the server is local to the
agent so we don’t need the server name in the code
Dim dbDir As New NotesDbDirectory(Server$)
Set db = dbDir.GetFirstDatabase(FileType)
dbsInQuestion = ""
While Not DB Is Nothing
'process databases
entryNbr = 0 ' initializes the ACL entry count
count = count+1 'helps with debugging
UnspecifiedNames = "" 'initialize unspecified
IndividualNames = "" 'initialize Individual
dbStr = DB.FilePath
'set up a log document to record captured data to
Set DbACLDoc = thisDb.CreateDocument()
DbACLDoc.Form = "DbACL"
DbACLDoc.DateCreated = startTime
DbACLDoc.LogTitle = thisAgent.Name
Set DocAuthors = New NotesItem(DbACLDoc, "Authors", "", AUTHORS)
Call DocAuthors.AppendToTextList("[ACL CHECK]")
Call DbACLDoc.Save(True,False)
If Server$ = "" Then
DbACLDoc.Server = AgentServerName.common
Else
DbACLDoc.Server = Server$
End If
DbACLDoc.filePath = db.FilePath
DbACLDoc.DBTitle = Db.Title
Call DbACLDoc.Save(True,False)
Set body = DbACLDoc.CreateRichTextItem( "Body" )
If Not db.OpenByReplicaID(Server$,db.ReplicaID) Then
Goto CantOpenDb
End If
If Not db.IsOpen Then
Call db.open("","")
End If
If db.IsOpen Then
'do some processing here
If indDbs = "" Then
IndDbs = Server$ +"\\" +dbStr
Else
IndDbs = indDbs + "; " + Server$ +"\\" +DBStr
End If
OpenCount = OpenCount + 1 'helps with devbugging
DbACLDoc.SuccessNbr = 1 'used for filtering out for views and reports
Dim item As NotesItem
Set item = DbACLDoc.ReplaceItemValue("Unspecifieds",UnspecifiedNames)
Set item = DbACLDoc.ReplaceItemValue("Individuals",PersonNames)
Else
CantOpenDb:
DbACLDoc.SuccessNbr = 0 'used for filtering out for views and reports
UnOpenCount = UnOpenCount + 1 'keeping track of db's not opened
If UnOpenCount = 1 Then
failedDbs = Server$ + "\\"+db.FilePath '+ "\" + db.Title
Else
failedDbs = failedDbs + "; " + Server$ + "\\"+db.FilePath '+ "\" + db.Title
End If
DbACLDoc.TotEntries = EntryNbr
Call DbACLDoc.Save(True,False)
Goto NextDB
End If
DbACLDoc.TotEntries = EntryNbr -1
Call DbACLDoc.Save(True,False)
NextDB:
entryNbr = 0 'reinitialize for next database
Set dbAclDoc = Nothing 'will need new one
Set db = Nothing
Set db = dbDir.GetNextDatabase()
Wend
Goto EndOfCode
NoAccessToDB:
If Err = 4072 Then 'server does not exist
errNbr = Err
body.AddNewline(1)
body.AppendText( Cstr(errNbr) + " - " + Server$ + ": Server does not exist")
Goto endOfCode
End If
DbACLDoc.Status = "Error - ACCESS DENIED" & "Error" & Str(Err) & ": " & Error$
body.AddNewline(1)
body.AppendText("The following error message was recieved at line number " & Erl() &"." & Chr(10) & "Error"
& Str(Err) & ": " & Error$)
Call DbACLDoc.Save(True,False)
logBody.AddNewline(1)
logBody.AppendText("The following error message was recieved at line number " & Erl() &"." & Chr(10) &
“Error” & Str(Err) & ": " & Error$)
Call logDoc.Save(True,False)
Resume Next
EndOfCode:
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////