本文共 1684 字,大约阅读时间需要 5 分钟。
'数据库路径
folder ="\D$\IBM\Lotus\Domino\data\mail" subject =Trim(InputBox("请输入邮件主题:","提示"))'添加服务器地址,逗号隔开
serverArray=Array("192.168.220.11","192.168.220.12")For i= LBound(serverArray) To UBound(serverArray)
mailFolder = "\\" & serverArray(i) & folder Set fso = CreateObject("scripting.fileSystemObject") Set folderObj = fso.GetFolder(mailFolder) For Each file In folderObj.Files names = Split(file.Name,".",-1) Call DeleteSubjectDocument(serverArray(i),names(0),subject) Next NextMsgBox "执行完成"
Sub DeleteSubjectDocument(server,user,subject)
On Error Resume Next Dim aNotes Dim aDatabase Dim aDC Dim aDoc Dim i Dim dt Set aNotes = CreateObject("Notes.NotesSession") ' 获取服务器上指定数据库 Set aDataBase = aNotes.GetDatabase(server, "mail/" & user) ' 指定日期 ' Set dt = aNotes.CREATEDATETIME("12/22/12") ' Set aDC = aDatabase.Search("@Contains(Subject;""test"")", dt, 0) Set aDC = aDatabase.Search("@Contains(Subject;"""&subject&""")", Nothing, 0) Call aDC.RemoveAll(True) if err.Number >0 Then WriteLog "server=" & server & ",user=" &user &"删除主题:"& subject &",info:数据库拒绝访问" Else WriteLog "server=" & server & ",user=" &user &"删除主题:"& subject &",info:操作完成" End If Set aNotes = Nothing Set aDatabase = Nothing Set aDC = Nothing Set aDoc = Nothing Set dt = Nothing End Sub Sub WriteLog(info)logFolder = "c:\log"
Set fso = CreateObject("scripting.FileSystemObject") If Not fso.FolderExists(logFolder) Then fso.CreateFolder logFolder End If filepath=logFolder & "\mail_log.txt" Set logFile = fso.OpenTextFile(filepath,8,True) logFile.WriteLine Now() & ": " & info logFile.CloseSet logFile = Nothing
Set fso = nothing End Sub本文转自 高文龙 51CTO博客,原文链接:http://blog.51cto.com/gaowenlong/1098089,如需转载请自行联系原作者