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

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

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