dos命令在vba中应用

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

Sub ListFilesTest()

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(myPath, 1) <> "\" 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(3).Offset(1) = f.Path
    Next

    For Each fd In fld.SubFolders
'        [a65536].End(3).Offset(1) = " " & fd.Name & ""
        [a65536].End(3).Offset(1) = 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 = 0 To UBound(ar)
        Cells(i + 1, 1) = ar(i)
    Next
    
    Set wExec = Nothing
    Set WSH = Nothing
    
End Sub

 

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

Sub ListFilesDos()

    Set myfolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
    
    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(34) & myPath & Chr(34)).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 = "", 0, 1) & " Files " & s
    
    End With
    
    [a:a] = "": If UBound(ar) > -1 Then [a2].Resize(1 + UBound(ar)) = WorksheetFunction.Transpose(ar)

End Sub

'上例简写如下
Sub ListFilesDos_lcx()

    Set myfolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
    
    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(34) & myPath & "\*.xls*" & Chr(34)).StdOut.ReadAll, vbCrLf)
    
    End With
    
    [a:a] = "": If UBound(ar) > -1 Then [a2].Resize(1 + 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