正常情況下想要遍歷文件夾和子文件夾，可以采用遞歸的方式

Sub ListFilesTest()With Application.FileDialog(msoFileDialogFolderPicker)If .Show Then myPath$ = .SelectedItems(1) Else Exit SubEnd WithIf Right(myPath, 1) <> "\" Then myPath = myPath & "\" [a:a] = ""Call ListAllFso(myPath)End SubFunction 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.PathNextFor Each fd In fld.SubFolders ' [a65536].End(3).Offset(1) = " " & fd.Name & ""[a65536].End(3).Offset(1) = fd.PathCall ListAllFso(fd.Path)Next End Function

但用過DOS命令的都知道，DOS有個命令，一句話就可以遍歷文件夾和子文件夾，下面用vba來實現(xiàn)DOS的dir命令，實現(xiàn)上面的功能

Sub 遍歷文件夾()Dim WSH, wExec, sCmd As String, Result As String, arSet 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.ReadAllar = Split(Result, vbCrLf)For i = 0 To UBound(ar)Cells(i + 1, 1) = ar(i)NextSet wExec = NothingSet WSH = NothingEnd Sub

?

在學(xué)習(xí)使用這個功能的時候看到一個網(wǎng)上的例子，寫的很好，而且還讓我意外的學(xué)習(xí)到一個filter的函數(shù)，這個函數(shù)的功能也是相當(dāng)強大了

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'在這里輸入需要指定的關(guān)鍵字，可以是文件名的一部分，或指定文件類型如 ".xlsx"myFile$ = InputBox("Filename", "Find File", ".xlsx")tms = TimerWith CreateObject("Wscript.Shell")'所有文檔含子文件夾 chr(34)是雙引號"",因為代碼中要表達(dá)"",需要寫成"""" 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竟然可以過濾數(shù)組，太厲害了，早知道有這個函數(shù)的話，以前寫著玩的好些代碼玩起來就省事多了tms = Timer: ar = Filter(ar, myFile)Application.StatusBar = Format(Timer - tms, "0.00000") & " Find " & UBound(ar) + IIf(myFile = "", 0, 1) & " Files " & sEnd 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 SubWith CreateObject("Wscript.Shell")'所有文檔含子文件夾 chr(34)是雙引號"",因為代碼中要表達(dá)"",需要寫成"""" 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命令也是很強大很好用了，電腦里的可執(zhí)行文件，shell都可以執(zhí)行，shell也是可以執(zhí)行cmd的，只是無法獲取到cmd控制臺的數(shù)據(jù)

Sub 打開路徑()Shell "cmd /c ipconfig > """ & ThisWorkbook.Path & "\ip.txt"""Shell "explorer.exe " & ThisWorkbook.Path, vbNormalFocusEnd Sub

?

轉(zhuǎn)載于:https://www.cnblogs.com/LcxSummer/p/10382978.html

與50位技術(shù)專家面對面20年技術(shù)見證，附贈技術(shù)全景圖

總結(jié)

以上是生活随笔為你收集整理的dos命令在vba中应用的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。