想请教下:就是某个邮件服务器下有个mail文件夹,如何取到那个文件夹里所有文件的文件名和文件标题?????????
NotesDbDirectory 这个可以用来遍历数据库 Try
Sub Initialize
On Error Goto errproc
Dim Session As New NotesSession
Dim Dire As NotesDbDirectory
Dim Db As NotesDatabase
Dim mACL As NotesACL
Dim mACLEntry As NotesACLEntry
Dim Collection As NotesDocumentCollection
Dim curdb As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim myACL As NotesACL
Dim myACLEntry As NotesACLEntry
Dim viewpz As notesview
Dim docpz As notesdocument
'Dim mUtil As Variant
'Dim item As notesitem
'Dim DirName As notesitem
Dim FileName As String
Dim Index As Integer
Index = 1
ServerStr$ = Inputbox("Name of server(eg:test/test)?", "Server")
If ServerStr$ ="" Then
Msgbox "输入服务器Server才能继续执行!"
Exit Sub
End If
DirName$ = Inputbox("Name of Directory(eg:testoa)?", "Directory")
If DirName$ ="" Then
Msgbox "输入服务器Directory才能继续执行!"
Exit Sub
End If
Index = 1
Dim excelApp As Variant
Dim excelWorkbook As Variant
Dim excelSheet As Variant
Set excelApp=CreateObject("Excel.Application")
excelApp.Visible = True
Set excelWorkbook = excelApp.Workbooks.Add
Set excelSheet = excelWorkbook.Worksheets("Sheet1")
excelSheet.Cells(1,1).Value = "数据库名称"
excelSheet.Cells(1,2).Value = "文件目录"
excelSheet.Cells(1,3).Value = "文件名"
excelSheet.Cells(1,4).Value = "文档数"
excelSheet.Cells(1,5).Value = "文件大小(M)"
Set Dire = Session.GetDbDirectory(ServerStr$)
Set Db = Dire.GetFirstDatabase(DATABASE)
While Not Db Is Nothing
If Instr(db.FilePath,DirName$+"\")>0 Then
Index = Index + 1
excelSheet.Cells(Index,1).Value = Db.title
excelSheet.Cells(Index,2).Value = Db.FilePath
excelSheet.Cells(Index,3).Value = Db.filename
Call Db.open("", "")
excelSheet.Cells(Index,4).Value = Db.AllDocuments.Count
tmp# = 1024^2
excelSheet.Cells(Index,5).Value = Db.size/tmp#
End If
Set Db = Dire.GetNextDatabase
Wend
Exit Sub
errproc:
Msgbox "Error:"+Error$+" in Line:"+Cstr(Erl())
If Not (excelApp Is Nothing) Then
excelApp.DisplayAlerts = False
excelApp.Quit
Set excelApp= Nothing
End If
Msgbox "Error:"+Error$+" in Line:"+Cstr(Erl())
End Sub