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