'------------------------------------------------------------
' FolderTree.vbs
' 自动生成目录树文件
' benbenknight
' 指定目录
strFolderPath = "D:网站"
' 目录树文件
strFilePath = "D:tree.txt"
' 生成目录树
strFolderTree = FormFolderTree(strFolderPath, 0)
' 写入文件
WriteStringToFile strFilePath, strFolderTree
MsgBox "成功生成目录树文件"
'-------------- 以下是子函数 ---------------
Function FormFolderTree(strFolderPath, nLevel)
' 递归遍历指定目录,生成目录树字符串
' 用Tab来表示目录树的层次
' 目录名前加"[D]"
' strFolderPath 指定目录的全路径
' nLevel 目录层数,最初指定为0
' debug
If nLevel = 2 Then
nDebug = 1
End If
' 目录树字符串
strFolderTree = ""
' 一行字符串
strLine = ""
' 目录类型字符串
strFolderType = "[D]"
' 每行的前缀
' 美观起见,采用"| "和"|-------"两种字符串组合
strPrefix = ""
i = nLevel
While i >= 0
If i > 0 Then
strPrefix = strPrefix & "| "
Else
strPrefix = strPrefix & "|-------"
End If
i = i - 1
Wend
' 创建文件系统对象
Set ofs = CreateObject("Scripting.FileSystemObject")
' 判断目录是否存在
If (ofs.FolderExists(strFolderPath)) Then
' 打开目录
Set ofolder = ofs.GetFolder(strFolderPath)
' 添加当前目录
strLine = strFolderType & ofolder.Name & vbCrLf
strFolderTree = strFolderTree & strLine
' 访问该目录下的每个文件
Set ofiles = ofolder.Files
For Each ofile In ofiles
' 追加到当前文件名目录树中
strLine = strPrefix & ofile.Name & vbCrLf
strFolderTree = strFolderTree & strLine
Next
' 访问该目录下的每个目录
Set osubfolders = ofolder.subfolders
For Each osubfolder In osubfolders
' 追加字符串
strLine = strPrefix & FormFolderTree(osubfolder.Path, nLevel + 1)
strFolderTree = strFolderTree & strLine
Next
End If
' 返回目录树字符串
FormFolderTree = strFolderTree
End Function
Sub WriteStringToFile(strFilePath, strInfo)
' 将字符串写入文本文件
' strFilePath 文本文件全路径
' strInfo 字符串
' 文件读写标志
Const ForReading = 1, ForWriting = 2
Set ofs = CreateObject("Scripting.FileSystemObject")
' 打开文件
Set ofile = ofs.OpenTextFile(strFilePath, ForWriting, True)
' 写入文件
ofile.Write strInfo
'关闭文件
ofile.Close
End Sub
'------------------------------------------------------------
修改指定目录和目录树文件即可。执行后可以列出目录以及文件。
注意,格式需要ANSI才行。
代码完整摘录自:https://blog.sina.com.cn/s/blog_50ee72f101009q4g.html
如您从本文得到了有价值的信息或帮助,请考虑扫描文末二维码捐赠和鼓励。
如本文对您有用,捐赠和留言 将是对我最好的支持~(捐赠可转为站内积分)
如愿意,请向朋友推荐本站,谢谢。
尊重他人劳动成果。转载请务必附上原文链接,我将感激不尽。
留言