dos命令在vba中应用

正常情况下想要遍历文件夹和子文件夹，可以采用递归的方式

Sub ListFilesTest()

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myPath$ = .SelectedItems() Else Exit Sub
    End With
    If Right(myPath, ) <> "\" Then myPath = myPath & "\"

    [a:a] = ""
    Call ListAllFso(myPath)

End Sub

Function ListAllFso(myPath$)
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)

    For Each f In fld.Files
'        [a65536].End(3).Offset(1) = f.Name
        [a65536].End().Offset() = f.Path
    Next

    For Each fd In fld.SubFolders
'        [a65536].End(3).Offset(1) = " " & fd.Name & ""
        [a65536].End().Offset() = fd.Path
        Call ListAllFso(fd.Path)
    Next
End Function

但用过DOS命令的都知道，DOS有个命令，一句话就可以遍历文件夹和子文件夹，下面用vba来实现DOS的dir命令，实现上面的功能

Sub 遍历文件夹()

    Dim WSH, wExec, sCmd As String, Result As String, ar

    Set WSH = CreateObject("WScript.Shell")

'   Set wExec = WSH.Exec("ping 127.0.0.1")
    Set wExec = WSH.exec("cmd /c dir /b /s D:\lcx\*.xls*")

    Result = wExec.StdOut.ReadAll
    ar = Split(Result, vbCrLf)

    For i =  To UBound(ar)
        Cells(i + , ) = ar(i)
    Next

    Set wExec = Nothing
    Set WSH = Nothing

End Sub

在学习使用这个功能的时候看到一个网上的例子，写的很好，而且还让我意外的学习到一个filter的函数，这个函数的功能也是相当强大了

Sub ListFilesDos()

    Set myfolder = CreateObject("Shell.Application").BrowseForFolder(, "GetFolder", )

    If Not myfolder Is Nothing Then myPath$ = myfolder.Items.Item.Path Else MsgBox "Folder not Selected": Exit Sub

    '在这里输入需要指定的关键字，可以是文件名的一部分，或指定文件类型如 ".xlsx"
    myFile$ = InputBox("Filename", "Find File", ".xlsx")

    tms = Timer

    With CreateObject("Wscript.Shell")

        '所有文档含子文件夹 chr(34)是双引号"",因为代码中要表达"",需要写成"""" vbCrLf 回车换行
        ar = Split(.exec("cmd /c dir /a-d /b /s " & Chr() & myPath & Chr()).StdOut.ReadAll, vbCrLf)

        s = "from " & UBound(ar) & " Files by Search time: " & Format(Timer - tms, " 0.00000") & " in: " & myPath
        
　　　　　　　　　　　　 这个filter竟然可以过滤数组，太厉害了，早知道有这个函数的话，以前写着玩的好些代码玩起来就省事多了
        tms = Timer: ar = Filter(ar, myFile)

        Application.StatusBar = Format(Timer - tms, "0.00000") & " Find " & UBound(ar) + IIf(myFile = "", , ) & " Files " & s

    End With

    [a:a] = "": If UBound(ar) > - Then [a2].Resize( + UBound(ar)) = WorksheetFunction.Transpose(ar)

End Sub

'上例简写如下
Sub ListFilesDos_lcx()

    Set myfolder = CreateObject("Shell.Application").BrowseForFolder(, "GetFolder", )

    If Not myfolder Is Nothing Then myPath$ = myfolder.Items.Item.Path Else MsgBox "Folder not Selected": Exit Sub

    With CreateObject("Wscript.Shell")

        '所有文档含子文件夹 chr(34)是双引号"",因为代码中要表达"",需要写成"""" vbCrLf 回车换行
        ar = Split(.exec("cmd /c dir /a-d /b /s " & Chr() & myPath & "\*.xls*" & Chr()).StdOut.ReadAll, vbCrLf)

    End With

    [a:a] = "": If UBound(ar) > - Then [a2].Resize( + UBound(ar)) = WorksheetFunction.Transpose(ar)

End Sub

shell命令也是很强大很好用了，电脑里的可执行文件，shell都可以执行，shell也是可以执行cmd的，只是无法获取到cmd控制台的数据

Sub 打开路径()

    Shell "cmd /c ipconfig > """ & ThisWorkbook.Path & "\ip.txt"""

    Shell "explorer.exe " & ThisWorkbook.Path, vbNormalFocus

End Sub