Question

我在通过outlook邮件文件夹递归时遇到问题。

Function listsubfolders(folParent)
'If folParent.Folders.count = 0 Then
'WScript.Echo folParent.name
'Else
    For Each subfolder In folParent.Folders
        tempstr = folParent.name  & ">" & listsubfolders(subfolder)
        WScript.Echo tempstr
    Next
'End If 

End Function

Answer 1

以下是如何使用递归将所有子文件夹列入文件夹的示例。

Option Explicit
Dim fso,ws,RootFolder,LogFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
    fso.DeleteFile(LogFile)
End If
Set RootFolder = fso.GetFolder(Browse4Folder())
Call ListSubFolders(RootFolder)
ws.run DblQuote(LogFile)
'**********************************************************************************************
Sub ListSubFolders(Folder)
    Dim Subfolder
    Set Folder = fso.GetFolder(Folder)
    For Each Subfolder in Folder.SubFolders
        Call WriteLog(Subfolder.Path)
        Call ListSubFolders(Subfolder.Path) 'Call Recursive Sub
    Next
End Sub 
'**********************************************************************************************
Sub WriteLog(strText)
    Dim fs,ts,LogFile
    Const ForAppending = 8
    LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
    ts.WriteLine strText
    ts.Close
End Sub
'**********************************************************************************************
Function Browse4Folder()
    Dim objShell,objFolder,Message
    Message = "Please select a folder in order to scan into it and its subfolders"
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0,Message,1,"c:\Programs")
    If objFolder Is Nothing Then
        Wscript.Quit
    End If
    Browse4Folder = objFolder.self.path
end Function
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

使用recursion-Vbscript列出outlook MailBox文件夹层次结构

1 个答案: