VBS脚本模拟tree命令：vbsTree

slore

'-------------vbsTree.vbs------------------------
'描述:用vbs输出一个文件夹的目录结构。
'------------------------------------------------
Const Unit4Size = "字节KBMBGB"
Const OutFile = "OutTree.txt"
Dim theApp,SelPath,TreePath,TreeStr
Set theApp = CreateObject("Shell.Application")
Set SelPath = theApp.BrowseForFolder(0,"请选择需要列出子项目的路径",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 "查看当前目录下的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

自己测试下效果看看～

fastslz

我把文件夹浏览部分优化下

1. '-------------vbsTree.vbs------------------------
   
2. '描述:用vbs输出一个文件夹的目录结构。
   
3. '------------------------------------------------
   
4. Const Unit4Size = "字节KBMBGB"
   
5. Const OutFile = "OutTree.txt"
   
6. Dim TreePath,TreeStr,WS
   
7. Set WS = WScript.CreateObject("WScript.Shell")
   
8. TreePath = BFF("请选择需要列出子项目的路径",&H0001 + &H0008 + &H0010,"")
   
9. Set WS = Nothing
   
10. If Len(TreePath) = 0 Then WScript.Quit
    
11. If Len(TreePath) <= 3 Then MsgBox "无法处理根目录！",64,"提示":WScript.Quit
    
12. 
    
13. Dim objFSO
    
14. Set objFSO = CreateObject("Scripting.FileSystemObject")
    
15. TreeStr = TreePath & FormatSize(objFSO.GetFolder(TreePath).Size) & vbCrLf
    
16. Tree TreePath,""
    
17. Set objFile = objFSO.CreateTextFile(OutFile,True)
    
18. objFile.Write TreeStr
    
19. objFile.Close
    
20. Set objFile = Nothing
    
21. Set objFSO = Nothing
    
22. MsgBox "查看当前目录下的OutTree.txt",vbInformation,"完成 - vbsTree"
    
23. Sub Tree(Path,SFSpace)
    
24.     Dim i,TempStr,FlSpace
    
25.     FlSpace = SFSpace & "  "
    
26.     Set CrntFolder = objFSO.GetFolder(Path)
    
27.     i = 0:TempStr = "├─"
    
28.     For Each ConFile In CrntFolder.Files
    
29.         i = i + 1
    
30.         If i = CrntFolder.Files.Count And CrntFolder.SubFolders.Count = 0 Then TempStr = "└─"
    
31.         TreeStr = TreeStr & FlSpace & Tempstr & ConFile.name & FormatSize(ConFile.size) & vbCrLf
    
32.     Next
    
33.     i = 0:TempStr = "├─"
    
34.     For Each SubFolder In CrntFolder.SubFolders
    
35.         i = i + 1
    
36.         If i = CrntFolder.SubFolders.Count Then
    
37.             TempStr = "└─"
    
38.             SFSpace = FlSpace & "  "
    
39.         Else
    
40.             SFSpace = FlSpace & "│"
    
41.         End If
    
42.         TreeStr = TreeStr & FlSpace & TempStr & SubFolder.name & FormatSize(SubFolder.size) & vbCrLf
    
43.         Tree SubFolder,(SFSpace)
    
44.     Next
    
45. End Sub
    
46. Function FormatSize(SZ)
    
47.     Dim i
    
48.     Do While SZ > 1024
    
49.         i = i + 1
    
50.         SZ = SZ \ 1024
    
51.     Loop
    
52.     FormatSize = "  (" & SZ & Mid(Unit4Size,1 + 2 * i,2) & ")"
    
53. End Function
    
54. 
    
55. 
    
56. Function BFF(title, flag, dir)
    
57. On Error Resume Next
    
58. Dim oShell, oItem, oStr
    
59. Set oShell = WScript.CreateObject("Shell.Application")
    
60. Set oItem = oShell.BrowseForFolder(&H0, title, flag, dir)
    
61. oStr = oItem.Title
    
62. If Err <> 0 Then
    
63.     Set oShell = Nothing
    
64.     Set oItem = Nothing
    
65.     Exit Function
    
66. End If
    
67. 
    
68. If InStr(oStr, ":") Then
    
69. BFF = mid(oStr,InStr(oStr, ":")-1, 2)
    
70.     Else
    
71.         Select Case oStr
    
72.             Case "桌面"
    
73.                 BFF = WS.SpecialFolders("Desktop")
    
74.             Case "我的文档"
    
75.                 BFF = WS.SpecialFolders("MyDocuments")
    
76.             Case "我的电脑"
    
77.                 MsgBox "无效目录！",64,"提示":WScript.Quit
    
78.             Case "网上邻居"
    
79.                 MsgBox "无效目录！",64,"提示":WScript.Quit
    
80.             Case Else
    
81.              BFF = oItem.ParentFolder.ParseName(oItem.Title).Path
    
82.         End Select
    
83.     End If
    
84. Set oShell = Nothing
    
85. Set oItem = Nothing   
    
86. If Right(BFF,1)<> "" Then
    
87.     BFF = BFF & ""
    
88. End If
    
89. On Error GoTo 0
    
90. End Function

复制代码

slore

根目录是可以遍历的……

对了，要更新copy下cn-dos那个吧，那个做了点修改。

HMPT

回复 2# fastslz


    无法作用于中文目录啊。。。