[问题求助] vbs如何实现输出指定路径/目录/文件夹下所有子文件夹及文件的路径

ghost-jason

如果哪位大神牛的话顺便把文件夹下有哪些东西显示出来。文件夹下存放的东西，子文件夹下存放的东西。小弟只当学习。大神就当重新温习温习。谢谢啦！！！

DAIC

Dim objShell
Set objShell = CreateObject("WSCript.Shell")
objShell.Run "cmd /k dir D:\"
Set objShell = Nothing
复制代码

Dim objShell
Set objShell = CreateObject("WSCript.Shell")
objShell.Run "cmd /k dir /s D:\"
Set objShell = Nothing

ghost-jason

回复 2# DAIC


    谢啦。不要bat的。能不能用vbs代码写。遍历的那种

DAIC

回复 3# ghost-jason


    把2楼代码保存为test.vbs，执行的时候报错了吗？

ghost-jason

回复 4# DAIC

报错了
能不能写个纯vbs脚本的，谢啦

DAIC

回复 5# ghost-jason


    你的D盘是不是光驱？

ghost-jason

回复 6# DAIC


    恩恩。是了。我换了个盘。能行。但是我不想用bat。比如d盘下有一个文件夹test而这个test文件夹下还有一个文件夹test1就是d:\test\test1\test2等等
就是这种效果

yu2n

给你个……

' +----------------------------------------------------------------------------+
' | 递归查找文件类：可自定义扫描目录层数、文件类型 |
' +----------------------------------------------------------------------------+
Class Scan_Folder
    ' ==============================================================================================================
    ' 类初始化
    ' ==============================================================================================================
    ' 公共变量
    Private fso, regEx, sFolderSpec, sParentFolderLayer, sMaxLayer, sFileType_RegExPatternt, sFileType, sFileList, sFolderList, sEmptyFolderList
    Private Scan_Folder_Only, Scan_Folder_Sub
    '类初始化事件
    Private Sub Class_Initialize
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
            regEx.IgnoreCase = True     ' 设置是否区分大小写。
            regEx.Global = True         ' 设置全局替换。
            regEx.MultiLine = True      ' 设置多行匹配模式
        Scan_Folder_Only = True           ' 仅扫描文件夹(提高效率)
        Scan_Folder_Sub = True            ' 扫描子文件夹
    End Sub
    ' ==============================================================================================================
    ' 获取设定
    ' ==============================================================================================================
    ' 设置扫描目录
    Public Function FolderSpec(ByVal strFolderSpec)
        sFolderSpec = strFolderSpec
    End Function
    ' 设置最大扫描目录层数
    Public Function MaxLayer(ByVal strMaxLayer)
        sMaxLayer = strMaxLayer
    End Function
    ' 设置扫描的文件类型
    Public Function FileType_RegExPatternt(ByVal strFileType_RegExPatternt)
        sFileType_RegExPatternt = strFileType_RegExPatternt
    End Function
    ' 获取文件夹列表(包括空文件夹)
    Public Function GetFolderList()
        Scan_Folder_Only = True
        Scan_Layer sFolderSpec
        GetFolderList = sFolderList
    End Function
    ' 获取空文件夹列表
    Public Function GetEmptyFolderList()
        Scan_Folder_Only = False
        Scan_Layer sFolderSpec
        GetEmptyFolderList = sEmptyFolderList
    End Function
    ' 获取文件列表
    Public Function GetFileList()
        Scan_Folder_Only = False
        Scan_Layer sFolderSpec
        GetFileList = sFileList
    End Function
    ' 关闭控件
    Public Sub Close()
        Set fso = Nothing
        Set regEx = Nothing
    End Sub
    ' ==============================================================================================================
    ' 私有函数
    ' ==============================================================================================================
    ' 递归扫描
    Private Function Scan_Layer(strFolderspec)
        On Error Resume Next
        If Not Right(strFolderspec,1) = "\" Then strFolderspec = strFolderspec & "\"
        If Not IsEmpty(sFolderList) Then sFolderList = sFolderList & vbCrLf
        sFolderList = sFolderList & strFolderspec
        ' 文件夹对象
        Dim oFolder, oSubFolderItems, oSubFileItems, oSubFolder, oSubFile
        Set oFolder = fso.GetFolder(strFolderspec)
        ' 是否扫描 当前文件夹 的 子文件
        If Scan_Folder_Only = False Then
            ' 子文件对象集合
            Set oSubFileItems = oFolder.Files
            ' 查找当前文件夹 的 文件
            If oSubFileItems.Count <> 0 Then
                For Each oSubFile In oSubFileItems
                    If IsEmpty(sFileType_RegExPatternt) Or (sFileType_RegExPatternt = "") Then
                        If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
                        sFileList = sFileList & oSubFile.Path
                    Else
                        ' 过滤文件类型(适用正则表达式)
                        regEx.Pattern = sFileType_RegExPatternt
                        If regEx.Execute( fso.GetExtensionName(oSubFile) ).Count > 0 Then
                            If Not IsEmpty(sFileList) Then sFileList = sFileList & vbCrLf
                            sFileList = sFileList & oSubFile.Path
                        End If
                    End If
                Next
            End If
        End If
        ' 查找当前文件夹 的 子文件夹
        Set oSubFolderItems = oFolder.SubFolders        ' 子文件夹对象集合
        ' --------没有子文件夹时
        If oSubFolderItems.Count = 0 Then
            ' --------也没有子文件时(此文件夹为空)
            If Scan_Folder_Only = False Then
                If oSubFileItems.Count = 0 Then
                    If Not IsEmpty(sEmptyFolderList) Then sEmptyFolderList = sEmptyFolderList & vbCrLf
                    sEmptyFolderList = sEmptyFolderList & strFolderspec
                End If
            End If
        Else
            ' 限制递归的最大层数
            If Not (IsEmpty(sMaxLayer) Or (sMaxLayer = "")) Then
                Dim s, f, n
                s = Replace(strFolderspec, sFolderSpec, "", vbTextCompare, -1, 1)
                f = "\"
                n = (Len(s)-Len(Replace(s,f,"",vbTextCompare,-1,1)))/Len(f)    ' 统计字符串中某一单词出现次数
                If sMaxLayer < n Then Scan_Folder_Sub = False
            Else
                Scan_Folder_Sub = True
            End If
            If Scan_Folder_Sub = True Then
                ' ----有子文件夹时，递归查找
                For Each oSubFolder In oSubFolderItems
                    'sFolderList = sFolderList & oSubFolder.Path & vbCrLf
                    Scan_Layer oSubFolder.Path
                Next
            End If
        End If
    End Function
End Class
' 实例
Sub Demo(ByVal strFolderPath)
    Dim oScanDir, sFileList, sFolderList
    ' 创建对象
    Set oScanDir = New Scan_Folder
    ' 指定文件夹
    oScanDir.FolderSpec strFolderPath
    ' 设定扫描最大层数(可为空。默认扫描所有子文件夹)
    'oScanDir.MaxLayer 2
    ' 指定文件类型(可为空。正则表达式规则，默认则返回所有文件)
    oScanDir.FileType_RegExPatternt "(jpg|mp4)"
    ' 获取结果(必填。GetFileList返回文件列表，GetFolderList返回目录列表，GetEmptyFolderList返回空目录列表)
    sFileList = oScanDir.GetFileList
    sFolderList = oScanDir.GetFolderList
    ' 结束对象
    oScanDir.Close

    ' 对返回的结果进行操作(这里是获取属性)
    Set fso = CreateObject("Scripting.FileSystemObject")
    arrFilePath = Split(sFileList, vbCrLf, -1, vbTextCompare)
    For i = 0 To UBound(arrFilePath)
        strFilePath = arrFilePath(i)
        WScript.Echo "所在目录: " & fso.GetFile(strFilePath).ParentFolder
        WScript.Echo "名称: " & fso.GetFile(strFilePath).Name
        WScript.Echo "大小: " & fso.GetFile(strFilePath).Size
        WScript.Echo "最后修改时间: " & fso.GetFile(strFilePath).DateLastModified
    Next
End Sub
复制代码

不要嫌长……

ghost-jason

回复 8# yu2n


    我去大神啊。这个代码这么长还有正则表达式。这个太难了我得慢慢消化。哦对了你能不能给我分析一个代码

Function GetCurrentFolderFullPath  
Set fso = CreateObject("Scripting.FileSystemObject")  
GetCurrentFolderFullPath = fso.GetParentFolderName(WScript.ScriptFullName)  
 End Function
 '以上代码得到该脚本所在的路径
 
Function GetSubFolders(currentFolderFullPath)  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set currentFolder = fso.GetFolder(currentFolderFullPath)  
    Set subFolderSet = currentFolder.SubFolders  
    For Each subFolder in subFolderSet  
        'MsgBox "subFolder.Path=" & subFolder.Path   
        GetSubFolders =subFolder.Path  & vbcrlf  & GetSubFolders &  

GetSubFolders(subFolder.Path)   
         Next  
End Function  
MsgBox GetSubFolders(GetCurrentFolderFullPath)
复制代码

ghost-jason

回复 9# ghost-jason

ghost-jason

回复 8# yu2n


    你给的这个长代码怎么运行后没反应啊。我想看看效果

DAIC

回复 9# ghost-jason


    你可能需要了解一些基础的编程知识，比如：递归。

yu2n

回复 11# ghost-jason
上面那段是函数，不是程序。如果你在末尾加下面一句，那他就是一个扫描D:的实例程序(请以 CScript.exe  脚本.vbs 的方式运行)：

Call Demo("D:\")
复制代码

如果不是对文件数目很大的目录扫描，可以使用下面的代码（同时也是一个实例程序）：

Dim strPath
strPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%")
WScript.Echo ScanFolder(strPath)

Function ScanFolder(ByVal strPath)
    Dim arr()
    ReDim Preserve arr(0)
    Call SCAN_FOLDER(arr, strPath)
    ReDim Preserve arr(UBound(arr) - 1)
    ScanFolder = Join(arr, vbCrLf)
End Function
Function SCAN_FOLDER(ByRef arr, ByVal folderSpec)
    On Error Resume Next
    Dim fso, objItems, objFile, objFolder
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objItems = fso.GetFolder(folderSpec)
    If Right(folderSpec, 1) <> "\" Then folderSpec = folderSpec & "\"
    If (Not fso.FolderExists(folderSpec)) Then Exit Function
    For Each objFile In objItems.Files
        arr(UBound(arr)) = objFile.Path
        ReDim Preserve arr(UBound(arr) + 1)
    Next
    For Each objFolder In objItems.subfolders
        Call SCAN_FOLDER(arr, objFolder.Path)
    Next
    arr(UBound(arr)) = folderSpec
    ReDim Preserve arr(UBound(arr) + 1)
End Function
复制代码

yu2n

回复 9# ghost-jason
这段代码不难，如果你要明白这个函数每行语句的意思，直接百度查 vbs fso 就知道了。
我这里重复贴一下，相信你会一目了然：

VBS 文件操作对象FSO大全
http://blog.sina.com.cn/s/blog_611f50100100w7tv.html
复制代码

ghost-jason

回复 14# yu2n


    我就是不明白图上画红线的地方就我标的那4点其他代码我都明白