Board logo

標題: 取得資料夾內所有檔案名稱 [打印本頁]

作者: stephen    時間: 2010-5-27 22:42     標題: 取得資料夾內所有檔案名稱

請教各位前輩

舉例: 桌面有個AAA資料夾,內含數百個.XLS 或者 .PDF檔案
能否使用vba將資料夾內所有的檔案
取其檔案名稱,將其檔案名稱存於sheet中?
作者: Hsieh    時間: 2010-5-27 22:57

回復 1# stephen


Sub get_file()
fs = Dir("C:\桌面正確路徑\*.*")
Do Until fs = ""
r = r + 1
Cells(r, 1) = fs
fs = Dir
Loop
End Sub
作者: stephen    時間: 2010-5-27 23:04

謝謝板大
舊家找來的參考資料 ^^"  應用方式再修正一下同樣有效
'====================================
Private Sub CommandButton1_Click()
    Dim P As String
    P = ThisWorkbook.Path '指定資料夾路徑
    ActiveSheet.UsedRange.Offset(1).Clear
    Get_Picture P
End Sub
Private Sub Get_Picture(ByVal P As String)
    Dim Fs, C As Variant
    Set Fs = CreateObject("Scripting.FileSystemObject").GETFolder(P)
    With ActiveSheet
    For Each C In Fs.Files
        If C Like "*.xls" Then '指定副檔名
            .Cells(Application.CountA(.[C:C]) + 1, "C") = C.Name
        End If
     Next
    End With
        For Each C In Fs.SubFolders
            On Error Resume Next
            Get_Picture C
        Next
End Sub
作者: b9208    時間: 2010-5-28 11:43

各位前輩!
請教輸出的檔案清單後,可以再依照自定條件方式排列 (B欄) 及加上No. (A欄),如附檔 B0.rar。

[attach]1056[/attach]
作者: Hsieh    時間: 2010-5-28 13:20

回復 4# b9208
  1. Sub Sort_Data()
  2. Dim Ar(), Ay()
  3. fd = "E:\" '指定資料夾
  4. fs = Dir(fd & "*.xls") '指定副檔名
  5. Do Until fs = ""
  6. ReDim Preserve Ay(x)
  7. Ay(x) = fs
  8. x = x + 1
  9. fs = Dir
  10. Loop
  11. For Each a In Array("QWER", "ASDG", "FGHY", "Other Item")
  12.    For i = LBound(Ay) To UBound(Ay)
  13.        If Ay(i) Like "*" & a & "*" Then
  14.        ReDim Preserve Ar(s)
  15.        Ar(s) = Array("P" & s + 1, Ay(i))
  16.        Ay(i) = ""
  17.        s = s + 1
  18.        ElseIf a = "Other Item" And Ay(i) <> "" Then
  19.        ReDim Preserve Ar(s)
  20.        Ar(s) = Array("P" & s + 1, Ay(i))
  21.        s = s + 1
  22.        End If
  23.    Next
  24. Next
  25. [A8:B65536] = ""
  26. [A8].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
  27. End Sub
複製代碼

作者: b9208    時間: 2010-5-28 13:52

Dear Hsieh
Array("QWER", "ASDG", "FGHY", "Other Item")
上述中 "Other Item" 指的是除了前三項外的其他代碼
而不是"〞Other Item" 代碼,剛才測試其他代碼都不見了。
非常抱歉說明不詳細。
謝謝
作者: Hsieh    時間: 2010-5-28 16:00

回復 6# b9208


    那沒關係才對
除非指定的附檔名錯誤根本沒抓到這些檔名
作者: b9208    時間: 2010-5-28 16:21

Dear Hsieh
非常抱歉,自己錯誤。
巨集可以執行使用
感謝無私分享
作者: tomking    時間: 2011-12-27 16:20

超級版主,請教一下,

如何,依檔案名稱,依序取檔名.
作者: GBKEE    時間: 2011-12-27 16:27

回復 9# tomking
Hsieh超版 2# 程式不就是嗎?
作者: tomking    時間: 2011-12-28 14:38

回復 10# GBKEE


    DEAR 版主,

真的不是,,,
不會依檔案名稱 順序取出...
LIKE   DOS DIR/O   

PS: GOOGLE 了, & TRY 了好久...... 還是不行..

麻煩..
作者: GBKEE    時間: 2011-12-28 15:05

回復 11# tomking
不會依檔案名稱 順序取出 是依字母數字排序嗎? 會的
超版2#的程式
  1. Option Explicit
  2. Sub get_file()
  3.     Dim Fs As String, R As Integer
  4.     Fs = Dir("d:\*.xls")
  5.     Do Until Fs = ""
  6.         R = R + 1
  7.         Cells(R, 1) = Fs
  8.         Fs = Dir
  9.     Loop
  10. End Sub
複製代碼

作者: tomking    時間: 2011-12-28 15:14

回復 12# GBKEE


DEAR 版主.

取出之結果..

A1315406_111007134239.txt
A1315471_111007013737.txt
A1315512_111007151654.txt
A1315514_111007143414.txt
A1315518_111006154903.txt
A1315522_111006142632.txt
A1315523_111006210301.txt
A1315524_111007050816.txt
A1315528_111007100844.txt
A1315529_111007065329.txt
A1315532_111007023917.txt
A1315533_111007080556.txt
A1315534_111007082853.txt
A1315535_111007004455.txt
A1315536_111007054150.txt
A1315537_111006232723.txt
A0316611_111004083608.txt
A0316616_111005092947.txt
A0316636_111004085246.txt

真的搞不清楚..為什麼..


實在是很麻煩您...
作者: GBKEE    時間: 2011-12-28 15:35

回復 13# tomking
A0316611_111004083608.txt
A0316636_111004085246.txt
A1315406_111007134239.txt
A1315536_111007054150.txt
A1315537_111006232723.txt
這是我得到的排序  ,是你電腦怪怪的
作者: tomking    時間: 2011-12-28 16:39

回復 14# GBKEE


    DEAR 版主,

   好像找到問題了,,
  因取資料的位置,是網路磁碟機 ,,而它的系統是 LINUX  .

  ths..
作者: mybubble9987    時間: 2019-4-17 15:47

回復 3# stephen

請問一下,有只取出名稱,不取出附檔名.jpg的用法嗎?
因為我參考了你的程式改成自己的用法,但檔名出來之後連副檔名都會一起跑出來~
謝謝協助!




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)