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