Не могу обработать ошибку 4060 в цикле

deeeman

Well-known member
04.12.2007
383
0
#1
Добрый день!

нужно просканировать все базы на серверах и сделать логи по пользователям кто какие права на базы имеет.
соответсвенно есть настройка серверов
так же есть настройка папок (чтобы определять почтовая это база или нет)

НО! есть базы в которые нет доступа, мне их надо пропускать, но не получается...

какие то базы проскакивает а на каких то все равно валиться с ошибкой 4060

вот код, подскажите что не так?

Код:
Option Public
Option Declare
 
Dim db As NotesDatabase
Dim keyView As NotesView
Dim ScanDb As NotesDatabase
 
Sub Initialize
 
On Error GoTo ErrSub
'On Error Resume next
Dim agentName As String
agentName = "getLogs2"
 
MsgBox agentName + " Start!"
 
Dim s As New NotesSession
 
Dim i As Integer
Dim msg As String
Dim SetView As NotesView
Dim SetDoc As NotesDocument
Dim profDoc As NotesDocument
Dim directory As NotesDbDirectory
Dim flagEx As Boolean
Dim owner As String
Dim level As Integer
Dim StrFormula As String
Dim namesDb As NotesDatabase
Dim namesDC As NotesDocumentCollection
Dim namesDoc As NotesDocument
Dim maildblist() As String
Dim dblist() As String
Dim serverDSP As string
Dim pDoc As NotesDocument
 
Set db = s.Currentdatabase
Set SetView = db.Getview("Settings")
Set keyView = db.Getview("PersonLogByKey")
Set SetDoc = SetView.Getfirstdocument()
If SetDoc Is Nothing Then
MsgBox "Не найдена настройка!"
GoTo EndSub
End If
 
 
Set pDoc = keyView.Getfirstdocument()
While Not pDoc Is Nothing
Call pDoc.Removeitem("MailDBList")
Call pDoc.Removeitem("DBList")
Call pDoc.save(True,true)
Set pDoc = keyView.Getnextdocument(pDoc)
Wend
 
Set namesDb = s.Getdatabase(db.server,"names.nsf")
StrFormula = {form = "Person" & @LowerCase(CompanyName) = "} & LCase(SetDoc.Getitemvalue("Company")(0)) & {"}
 
Set namesDC = namesDb.Search(StrFormula,Nothing,0)
 
If namesDC.Count > 0 Then
Set namesDoc = namesDC.Getfirstdocument()
While Not namesDoc Is Nothing
 
ReDim maildblist(0)
ReDim dblist(0)
 
'создаем\обновляем карточку лога сотрудника
Set pDoc = CreatePersonLog(namesDoc.Getitemvalue("Owner")(0))
If pDoc Is Nothing Then GoTo nextP
 
ForAll server In SetDoc.Getitemvalue("Servers_1")
 
If InStr(server,"/") > 0 then
serverDSP = StrLeft(server,"/")
Else
serverDSP = server
End if
 
ForAll folder In SetDoc.Getitemvalue("Folders_1")
 
Set directory = s.GetDbDirectory(server)
Set ScanDb = directory.GetFirstDatabase(DATABASE)
While Not ScanDb Is Nothing
  level = 0
 
If UCase(StrLeft(Replace(ScanDb.Filepath,"/","\"),"\")) = UCase(folder) Then  'почта
 
Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
If Not ScanDb Is Nothing Then
  If ScanDb.Filepath = "" Then GoTo nextdb
  msg = ScanDb.Filepath
level = ScanDb.QueryAccess(namesDoc.Getitemvalue("Owner")(0))
End If
 
ReDim Preserve maildblist(UBound(maildblist)+1)
  maildblist(UBound(maildblist)) = ScanDb.Title & "~~" & ScanDb.Filepath & " (" & (serverDSP) & ")" & "~~" & CStr(level)
 
Else  'не почтовая бд
  Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
  If Not ScanDb Is Nothing Then
If ScanDb.Filepath = "" Then GoTo nextdb
level = ScanDb.QueryAccess(namesDoc.Getitemvalue("Owner")(0))
msg = ScanDb.Filepath
End If
 
  ReDim Preserve dblist(UBound(dblist)+1)
dblist(UBound(dblist)) = ScanDb.Title & "~~" & ScanDb.Filepath & " (" & (serverDSP) & ")" & "~~" & CStr(level)
 
End If
 
nextdb:
Set ScanDb = directory.Getnextdatabase
Wend
End ForAll
End ForAll
nextP:
 
Call pDoc.Replaceitemvalue("MailDbList", ArrayUnique(FullTrim(maildblist)))
Call pDoc.Replaceitemvalue("DbList", ArrayUnique(FullTrim(dblist)))
Call pDoc.save(True,true)
 
Set namesDoc = namesDC.Getnextdocument(namesDoc)
Wend
End If
 
MsgBox agentName + " Finish!"
 
EndSub:
Exit Sub
ErrSub:
If Err = 4060 Then GoTo nextdb
 
MsgBox  "Error (" & Err() & ") in " & agentName & " at line " & Erl() & ": " & Error()
Resume EndSub
End Sub
 
Function createPersonLog(lotusName As String) As NotesDocument
On Error GoTo ErrSub
'On Error Resume next
Dim agentName As String
agentName = "getLogs2/createPersonLog"
 
Dim logDoc As NotesDocument
 
Set logDoc = keyView.getdocumentbykey(lotusName)
If logDoc Is Nothing Then
 
Set logDoc = db.Createdocument()
Call logDoc.Replaceitemvalue("Form","PersonLog")
Call logDoc.Replaceitemvalue("NotesName",lotusName)
Call logDoc.Replaceitemvalue("MailDBList","")
Call logDoc.Replaceitemvalue("DBList","")
Call logDoc.save(True,True)
 
End If
 
Set createPersonLog = logDoc
 
EndSub:
Exit Function
ErrSub:
MsgBox  "Error (" & Err() & ") in " & agentName & " at line " & Erl() & ": " & Error()
Resume EndSub
End Function
 

savl

Lotus team
28.10.2011
2 136
105
#2
А где?
ScanD.isOpen , по этому флагу можно проверять.
Получить базу мало, надо еще проверить можно ли её открыть.
 

deeeman

Well-known member
04.12.2007
383
0
#3
вставляю isOpen до строки:
Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
всегда false
вставляю после, ошибка на самой строке Getdatabase

итог: не помогло.
 

deeeman

Well-known member
04.12.2007
383
0
#4
проблему решил. сервера между собой не дружили.главный не все мог открывать с дополнительного.
пришлось делать копию базы на другой сервер и там запускать агента.

а что нужно настроить чтобы сервера дружили?
на вкладке Security у дополнительного сервера стоит главный сервер везде кроме Administration и Full Administration
 

deeeman

Well-known member
04.12.2007
383
0
#6
1. в ACL базы на дополнительном сервере должно быть обязательно указан главный сервер для того чтобы главный мог открыть базу на дополнительном?
сейчас это не так, но главный некоторые открывает...а некоторые нет.

в одном домене.
конекшены есть.
 

oshmianski

Достойный программист
Lotus team
25.04.2012
556
8
#7
я бы в ACL добавил группу LocalDomainServers (или кастомную) и дал бы ей полные права. естественно, в этой группе должны быть все нужные сервера.
 
30.05.2006
1 345
11
#8
Что-бы фоновый агент на одном сервере мог открыть БД на другом сервере, он (1й сервер) должен быть помянут на 2-м как Trusted.
Вроде так...
 

motogarri

Well-known member
17.02.2010
200
3
#9
Помню была как-то пролема с db.IsOpen у меня. При получение объекта NotesDatabase из сессии проверка на IsOpen не работала. Когда брал New NotesDatabase, тогда работала корректно.