之前写过一篇文章，主要介绍了如何验证邮件组内的成员是否存在DOmino列表中的；因为我们都知道Domino是一个开源的软件，邮件组内的成员可以手动去添加，如果添加了未知用户的话在给邮件组发送邮件会有退信提示，说某个用户不在domino列表中，上篇文章中几乎可以满足，但是缺点是邮件组嵌套的邮件组无法查询，以下为网友更改后的代码：
Sub Initialize
On Error Goto errH
Dim session As NotesSession
Dim nab As NotesDatabase , view As NotesView , group As NotesDocument
Dim dc As NotesDocumentCollection
Dim tmp As NotesDocument , item As NotesItem
Set session = New NotesSession
'打开Notes Domino Directory
Msgbox |1. Open Domino Directory (|+session.Currentdatabase.Server+|!!|+ NAB_DB_PATH$ +|) ... |
Set nab = session.Getdatabase( session.Currentdatabase.Server , NAB_DB_PATH$ )
If Not nab.Isopen Then
Msgbox |*** Cannot open Domino Directory :( , Quit. |
Exit Sub
End If
Msgbox |1. Domino Directory opened.|
'open view
Msgbox |2. Process all groups ...|
Set view = nab.Getview( GROUP_VIEW_NAME$ )
If view Is Nothing Then
Msgbox |*** Cannot open Group View (|+ GROUP_VIEW_NAME$ +|) :( , Quit. |
Exit Sub
End If
'临时存储
Set tmp = session.Currentdatabase.Createdocument()
'processing docs in view
Set group = view.Getfirstdocument()
While Not group Is Nothing
'说明：
' 判断组成员是否存在于NAB中
' 判断方法 - 在NAB中检索组成员是否存在
'
Msgbox |[!] Processing GROUP:|+group.ListName(0)
tmp.tmpMembers = ""
Set item = tmp.Replaceitemvalue("tmpMembers", "")
Forall v In group.Members
If Len(Trim$(v))>0 Then 'v不是空字符串
'检索这个组中的成员中的组、个人和服务器是否存在
Set dc = nab.Search({
(Type="Group"&GroupType!="3"&Form="Group"&@UpperCase(ListName)="}+Ucase$(v)+{")
|
(Type="Person"&@IsMember(@Name([Abbreviate];"}+ Ucase$(v) +{");@Name([Abbreviate];@UpperCase(FullName))))
|
(Type="Person"&@UpperCase(InternetAddress)="}+ Ucase$(v) +{")
|
(Type="Server":"X400Server":"POServer"&Form="Server":"X400Server":"cc:Mail Post Office Server"&@Name([Abbreviate];@UpperCase(ServerName))=@Name([Abbreviate];"}+Ucase$(v)+{") )
} , Nothing , 1) '检索一个FullName
If dc.Count>0 Then
Msgbox |+++ |+ v +| in GROUP:|+group.ListName(0)+| found in NAB.|
Call item.Appendtotextlist(v)
Else
Msgbox |--- |+ v +| in GROUP:|+group.ListName(0)+| NOT found in NAB.|
End If
End If
End Forall
group.Members = Evaluate(| @Sort(@Trim(@Unique(tmpMembers))) |,tmp)
Call group.save(True,True)
Set group = view.Getnextdocument(group)
Wend
Msgbox |2. Process all groups ... done.|
Exit Sub
errH:
Msgbox "AA-001 error: "+Error$+"@"+Cstr(Erl())
Exit Sub
End Sub
本文转自 高文龙 51CTO博客，原文链接：http://blog.51cto.com/gaowenlong/1186332，如需转载请自行联系原作者
