vbsTree VBS腳本模擬tree命令

    用vbs輸出一個(gè)文件夾的目錄結(jié)構(gòu)，喜歡的朋友可以測(cè)試下
    代碼如下:
    '-------------vbsTree.vbs------------------------
    '描述:用vbs輸出一個(gè)文件夾的目錄結(jié)構(gòu)。
    '------------------------------------------------
    Const Unit4Size = "字節(jié)KBMBGB"
    Const OutFile = "OutTree.txt"
    Dim theApp,SelPath,TreePath,TreeStr
    Set theApp = CreateObject("Shell.Application")
    Set SelPath = theApp.BrowseForFolder(0,"請(qǐng)選擇需要列出子項(xiàng)目的路徑",0)
    If SelPath Is Nothing Then WScript.Quit
    TreePath = SelPath.items.Item.Path
    Set SelPathPath = Nothing
    Set theApp = Nothing
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    TreeStr = TreePath & FormatSize(objFSO.GetFolder(TreePath).Size) & vbCrLf
    Tree TreePath,""
    Set objFile = objFSO.CreateTextFile(OutFile,True)
    objFile.Write TreeStr
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "查看當(dāng)前目錄下的OutTree.txt",vbInformation,"完成 - vbsTree"
    Sub Tree(Path,SFSpace)
    Dim i,TempStr,FlSpace
    FlSpace = SFSpace & " "
    Set CrntFolder = objFSO.GetFolder(Path)
    i = 0:TempStr = "├─"
    For Each ConFile In CrntFolder.Files
    i = i + 1
    If i = CrntFolder.Files.Count And CrntFolder.SubFolders.Count = 0 Then TempStr = "└─"
    TreeStr = TreeStr & FlSpace & Tempstr & ConFile.name & FormatSize(ConFile.size) & vbCrLf
    Next
    i = 0:TempStr = "├─"
    For Each SubFolder In CrntFolder.SubFolders
    i = i + 1
    If i = CrntFolder.SubFolders.Count Then
    TempStr = "└─"
    SFSpace = FlSpace & " "
    Else
    SFSpace = FlSpace & "│"
    End If
    TreeStr = TreeStr & FlSpace & TempStr & SubFolder.name & FormatSize(SubFolder.size) & vbCrLf
    Tree SubFolder,(SFSpace)
    Next
    End Sub
    Function FormatSize(SZ)
    Dim i
    Do While SZ > 1024
    i = i + 1
    SZ = SZ \ 1024
    Loop
    FormatSize = " (" & SZ & Mid(Unit4Size,1 + 2 * i,2) & ")"
    End Function
    文件夾瀏覽部分優(yōu)化后的代碼
    代碼如下:
    '-------------vbsTree.vbs------------------------
    '描述:用vbs輸出一個(gè)文件夾的目錄結(jié)構(gòu)。
    '------------------------------------------------
    Const Unit4Size = "字節(jié)KBMBGB"
    Const OutFile = "OutTree.txt"
    Dim TreePath,TreeStr,WS
    Set WS = WScript.CreateObject("WScript.Shell")
    TreePath = BFF("請(qǐng)選擇需要列出子項(xiàng)目的路徑",&H0001 + &H0008 + &H0010,"")
    Set WS = Nothing
    If Len(TreePath) = 0 Then WScript.Quit
    If Len(TreePath) <= 3 Then MsgBox "無法處理根目錄！",64,"提示":WScript.Quit
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    TreeStr = TreePath & FormatSize(objFSO.GetFolder(TreePath).Size) & vbCrLf
    Tree TreePath,""
    Set objFile = objFSO.CreateTextFile(OutFile,True)
    objFile.Write TreeStr
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    MsgBox "查看當(dāng)前目錄下的OutTree.txt",vbInformation,"完成 - vbsTree"
    Sub Tree(Path,SFSpace)
    Dim i,TempStr,FlSpace
    FlSpace = SFSpace & " "
    Set CrntFolder = objFSO.GetFolder(Path)
    i = 0:TempStr = "├─"
    For Each ConFile In CrntFolder.Files
    i = i + 1
    If i = CrntFolder.Files.Count And CrntFolder.SubFolders.Count = 0 Then TempStr = "└─"
    TreeStr = TreeStr & FlSpace & Tempstr & ConFile.name & FormatSize(ConFile.size) & vbCrLf
    Next
    i = 0:TempStr = "├─"
    For Each SubFolder In CrntFolder.SubFolders
    i = i + 1
    If i = CrntFolder.SubFolders.Count Then
    TempStr = "└─"
    SFSpace = FlSpace & " "
    Else
    SFSpace = FlSpace & "│"
    End If
    TreeStr = TreeStr & FlSpace & TempStr & SubFolder.name & FormatSize(SubFolder.size) & vbCrLf
    Tree SubFolder,(SFSpace)
    Next
    End Sub
    Function FormatSize(SZ)
    Dim i
    Do While SZ > 1024
    i = i + 1
    SZ = SZ \ 1024
    Loop
    FormatSize = " (" & SZ & Mid(Unit4Size,1 + 2 * i,2) & ")"
    End Function
    Function BFF(title, flag, dir)
    On Error Resume Next
    Dim oShell, oItem, oStr
    Set oShell = WScript.CreateObject("Shell.Application")
    Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
    oStr = oItem.Title
    If Err <> 0 Then
    Set oShell = Nothing
    Set oItem = Nothing
    Exit Function
    End If
    If InStr(oStr, ":") Then
    BFF = mid(oStr,InStr(oStr, ":")-1, 2)
    Else
    Select Case oStr
    Case "桌面"
    BFF = WS.SpecialFolders("Desktop")
    Case "我的文檔"
    BFF = WS.SpecialFolders("MyDocuments")
    Case "我的電腦"
    MsgBox "無效目錄！",64,"提示":WScript.Quit
    Case "網(wǎng)上鄰居"
    MsgBox "無效目錄！",64,"提示":WScript.Quit
    Case Else
    BFF = oItem.ParentFolder.ParseName(oItem.Title).Path
    End Select
    End If
    Set oShell = Nothing
    Set oItem = Nothing
    If Right(BFF,1)<> "\" Then
    BFF = BFF & "\"
    End If
    On Error GoTo 0
    End Function