'数据库路径
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
Next
MsgBox "执行完成"
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.Close
Set logFile = Nothing
Set fso = nothing
End Sub
本文转自 高文龙 51CTO博客,原文链接:http://blog.51cto.com/gaowenlong/1098089,如需转载请自行联系原作者