- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
[分享] 使用〔命令列 CMD〕的 DOS/Dir 指令取出檔案明細到EXCEL
本帖最後由 准提部林 於 2015-9-14 15:30 編輯
使用〔命令列.CMD〕的 DOS / Dir 指令取出檔案明細到EXCEL
看到這題16樓.ikboy 大大的疑問:
[發問]多層資料夾尋找檔案的問題
http://forum.twbts.com/viewthrea ... a=pageD1&page=2
尚未去搜尋網上是否有這個VBA範例,先做個樣板試試,
本來想說應很簡單,執行卻時可時不可,修修改改如下,
若有更好修正版本,歡迎不吝提供!
_不是專行,寫起來就是跌跌撞撞。- Sub 取出檔案明細()
- Dim UF$, UP$, UT$, xD, FF, TRow, N&, j&, Brr, TT
- Call 清除
- UF = [A1].Value: If UF = "" Then Exit Sub '搜尋檔案名稱
- UP = ThisWorkbook.Path & "\" '搜尋路徑
- UT = UP & "UT_File.txt" '檔案明細文字檔檔名
-
- '↓若文字檔還存在,刪除
- On Error Resume Next: Kill UT: On Error GoTo 0
- '↓以〔命令列〕DIR指令產生檔案明細文字檔
- Shell "cmd.exe /c dir """ & UP & UF & """ /s /b > " & UT, vbHide
- '↓以DIR檢測是否可以抓到文字檔(檔案可能尚未就緒)
- Do Until Dir(UT) <> "": Loop
- '↓檢測文字檔是否還在寫入中,否則開啟時只是空白資料
- Do Until CheckBookOpen(UT) = 0: Loop
-
- '↓將文字檔內容逐筆納入〔字典檔〕
- Set xD = CreateObject("Scripting.Dictionary")
- FF = FreeFile
- Open UT For Input Access Read As #FF
- While Not EOF(1)
- Line Input #FF, TRow
- N = N + 1: xD(N) = TRow
- Wend
- Close #FF
- If N = 0 Then MsgBox "找不到檔案! ": Exit Sub
-
- '↓將字典檔內容拆出〔檔案名稱.完整路徑〕納入陣列
- ReDim Brr(N - 1, 1): N = 0
- For Each FF In xD.items
- If FF <> ThisWorkbook.FullName Then
- TT = InStrRev(FF, "\")
- Brr(N, 0) = Mid(FF, TT + 1)
- Brr(N, 1) = FF
- N = N + 1
- End If
- Next
-
- [A4:B4].Resize(N) = Brr '填入資料
- Kill UT '刪去文字檔
- End Sub
複製代碼 附件下載:
20150912a01(DOS-Dir取檔案明細).rar (13.47 KB)
注意:儘量不要在〔根目錄〕中執行,也儘量不要使用〔*.*〕去搜檔案,(量可能太大)∼∼
|
|