取得資料夾內所有檔案名稱

stephen

請教各位前輩

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

Hsieh

回復 1# stephen


Sub get_file()
fs = Dir("C:\桌面正確路徑\*.*")
Do Until fs = ""
r = r + 1
Cells(r, 1) = fs
fs = Dir
Loop
End Sub

stephen

謝謝板大
舊家找來的參考資料 ^^"  應用方式再修正一下同樣有效
'====================================
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

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

B0.rar (2.53 KB)

下載次數: 26

2010-5-28 11:43

Hsieh

回復 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

Dear Hsieh
Array("QWER", "ASDG", "FGHY", "Other Item")
上述中 "Other Item" 指的是除了前三項外的其他代碼
而不是"〞Other Item" 代碼，剛才測試其他代碼都不見了。
非常抱歉說明不詳細。
謝謝

Hsieh

回復 6# b9208


    那沒關係才對
除非指定的附檔名錯誤根本沒抓到這些檔名

b9208

Dear Hsieh
非常抱歉，自己錯誤。
巨集可以執行使用
感謝無私分享

tomking

超級版主,請教一下,

如何,依檔案名稱,依序取檔名.

GBKEE

回復 9# tomking
Hsieh超版 2# 程式不就是嗎?