domino 导出特定路径所有数据库的大小和数据量。服务端执行的代码范例
%REM
Agent (CheckOASysforWeb)
Description: Comments for Agent
%END REM
Option Public
Option Declare
Dim ss As NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim note As NotesDocument
Dim doc As NotesDocument
Dim High As Integer
Dim HighAll As Integer
Dim ans As String
Dim tempMaildb As NotesDatabase
Dim collection As NotesDocumentCollection
Dim pathFIR As String
Dim pathFIR2 As String
Dim pathFIR3 As String
Dim filepathOut As String
Dim ResultXlsPath As String
Dim XlsData As String
Dim sendtoMan As string
Sub Initialize
On Error GoTo delError
'检测本服务器特定目录的所有数据库大小并邮件发送管理员
'代码中已经注释掉删除相对路径的语句
'代理需要开启最高执行权限
'不同的环境的路径拼接不同
'Call killFile(temppath+"/"+v)
'RmDir(temppath+"/"+v) '删除目录!!!!!!
'
'Print "Content-type=text/html; charset=gb2312;"
sendtoMan="admin/***" '//收件地址
Print |Content-Type:application/vnd.ms-excel; charset=GB2312|
Print |Content-Disposition:Attachment; filename="data.xls"|
Print |<table border="1">|
Print "<tr>"
MessageBox "###数据库检测开始"
Set ss = New NotesSession
Set db = ss.Currentdatabase
Dim filepath As String
ans=""'记录函数执行结果,保存异常的数据名称
pathFIR="oa"
'pathFIR=""
If InStr(ss.Platform,"windows")>=1 Then
pathFIR2="/"'"\"
Else
pathFIR2="/"
End If
MessageBox "Platform="+ss.Platform
If pathFIR<>"" Then
filepath=ss.GetEnvironmentString("Directory", True)+pathFIR2+pathFIR '路径斜杠
pathFIR3=ss.GetEnvironmentString("Directory", True)+pathFIR2
Else
filepath=ss.GetEnvironmentString("Directory", True) '路径斜杠
pathFIR3=ss.GetEnvironmentString("Directory", True)
End If
MessageBox "filepath="+filepath
MessageBox "filepath="+filepath
MessageBox "filepath="+filepath
'filepath="C:\Program Files\IBM\Domino\data\domino\html\\u"
High=1
HighAll=4 '递推深度限制,首次为1。递推之前加一判断
Call ShowSonPath(filepath,High)'这是自我调用的递推函数
Print |</table>|
Call dataout()
MessageBox "###邮件数据库检测结束"+"-- end"
Exit Sub
delError:
MessageBox Error()+" at line:" +Cstr(Erl())+" passwords,代理 checkMailSys"
End Sub
Function dataout()
On Error GoTo ers
Dim mail_doc As NotesDocument'中间对象 不会保存
Dim bodyitem As Variant
Set mail_doc=db.Createdocument()
Set bodyitem =mail_doc.CreateRichTextItem("body")
Call bodyitem.AppendText(XlsData+Chr(10)+Chr(13) )
mail_doc.form = "memo"
mail_doc.subject ="数据库状态统计。"
mail_doc.sendto = sendtoMan
Call mail_doc.Send(False)
MessageBox "dataout----执行完成"
Exit Function
ers:
dataout="false"
MessageBox Error()+" at line:" +Cstr(Erl())+",fun dataout"
End Function
%REM
Sub killFile
Description: Comments for Sub
获取某个路径下的所有文件
获取某个路径下的所有目录
thishigh记录函数所在递推的次数。第一次为1,默认为0
%END REM
Sub ShowSonPath(path As String,thishigh As Integer)
On Error GoTo ShowSonPathError
'MessageBox "(path=)"+ path+" thishigh="+CStr(thishigh)
Dim temppath As String
Dim filenames As String
Dim filens As String
Dim nexhigh As Integer
nexhigh=thishigh
temppath = path
filenames=Dir(temppath+"/*.*", 0)'获取某路径下的所有文件夹和文件
Dim fs As Variant'存储某目录下所有文件的名称 不含目录 A;B;C;
Do While filenames <> ""
'MessageBox "大循环="+filenames
If fs ="" Then
fs=filenames
Else
'MessageBox "执行了几次-------filenames="+filenames
fs=fs+";"+filenames
End If
filenames = Dir$()
Loop
Dim temp3 As String
Dim high As Integer
high=1
If fs <> "" Then
fs=Split(fs,";")
ForAll f In fs
'如果需要删除文件 则在这边进行
temp3=temppath + pathFIR2+ f
temp3=Replace(temp3,pathFIR3,"")
'MessageBox "temp ="+temp3+" high="+CStr(high)
If InStr(temp3,"nsf")>1 Then
Set tempMaildb=ss.Getdatabase("",temp3,"")'不同环境斜杠不同
If Not tempMaildb.isopen Then
If ans<>"" Then
ans=ans+"@"+f'保存异常数据库名称
Else
ans=f'保存异常数据库名称
End If
'Print "<th>false# "+"文件路径 " + temppath + "/" + f+" #ReplicaID="+"####异常"+"</th><br>"
Print "<tr>"
Print "<th>false"+"#文件路径 " + temppath +pathFIR2 + f+" #ReplicaID="+"####异常"+"</th>"
Print "</tr>"
XlsData=XlsData+"false"+"#文件路径 " + temppath +pathFIR2 + f+" #ReplicaID="+"####异常"+Chr(10)+Chr(13)
Else
Set collection = tempMaildb.AllDocuments
Print "<tr>"
'Print "<th>true# "+"文件路径 #" + temppath+ "/" + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+"</th><br>"
Print "<th>true#"+"文件路径 #" + temppath+ pathFIR2 + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+" #size="+"#"+CStr(tempMaildb.size/1024/1024)+"MB"+"#数据库标题#"+CStr(tempMaildb.title)+"</th><br>"
XlsData=XlsData+"true#"+"文件路径 #" + temppath+ pathFIR2 + f+" #all="+CStr(collection.Count)+" #size="+"#"+CStr(tempMaildb.size/1024/1024)+"MB"+"#数据库标题#"+CStr(tempMaildb.title)+Chr(10)+Chr(13)
Print "</tr>"
End If
End If
high=high+1
'If high =10 Then
' Exit sub
'End If
End ForAll
End If
'获取某路径下的所有文件夹
filenames=Dir(temppath+"\*", 16)
Dim lastStr As String
Dim filelist As String
Do While filenames <> ""
If Right(filenames, 3) = "doc" Then
'Print "filenames " + filenames
End If
If InStr(filenames,".") <= 0 And Trim(filenames) <> "" And InStr(filenames, "ATT") <= 0 Then '有ATT开头的无后缀的文件不要
'记录文件夹
If filelist ="" Then
filelist=filenames
Else
filelist=filelist+";"+filenames
End If
End If
filenames = Dir$()
Loop
' 递推文件夹
Dim temp As String
Dim vlist As Variant
If filelist <> "" Then
vlist=Split(filelist,";")
'thishigh=thishigh+1
nexhigh=nexhigh+1
ForAll v In vlist
If Trim(v) <> "" Then
'Print " ============执行递推文件夹="+temppath+"\"+v+" high="+CStr(nexhigh)
'Print "<th>深度#"+CStr(nexhigh)+"#执行递推文件夹#="+temppath+"\"+v+"</th><br>"
If nexhigh<=HighAll Then'对递推的高度进行限制
Call ShowSonPath(temppath+pathFIR2+v,nexhigh)'进行递推
Else
Print "超出递推次数------"
End If
End If
End ForAll
End If
Exit Sub
ShowSonPathError:
'Print "Error:-->"+"["+temppath+"]"+Error +"<br>"
MessageBox Error()+" at line:" +Cstr(Erl())+",Fun ShowSonPath"
End Sub