stephen

帖子: 7
主題: 3
精華: 0
積分: 19
點名: 0
作業系統: WINXP
軟體版本: 2002 SP3
閱讀權限: 10
性別: 男
來自: TAIWAN
註冊時間: 2010-5-4
最後登錄: 2019-12-5

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2010-5-27 22:42 | 只看該作者

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

請教各位前輩

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

樓主熱帖

請多指教

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 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

學海無涯_不恥下問

TOP

stephen

小學生 Rank: 1

帖子: 7
主題: 3
精華: 0
積分: 19
點名: 0
作業系統: WINXP
軟體版本: 2002 SP3
閱讀權限: 10
性別: 男
來自: TAIWAN
註冊時間: 2010-5-4
最後登錄: 2019-12-5

3^#

發表於 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

請多指教

TOP

b9208

中學生 Rank: 2

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

4^#

發表於 2010-5-28 11:43 | 只看該作者

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

B0.rar (2.53 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 2010-5-28 13:20 | 只看該作者

回復 4# b9208

Sub Sort_Data()
Dim Ar(), Ay()
fd = "E:\" '指定資料夾
fs = Dir(fd & "*.xls") '指定副檔名
Do Until fs = ""
ReDim Preserve Ay(x)
Ay(x) = fs
x = x + 1
fs = Dir
Loop
For Each a In Array("QWER", "ASDG", "FGHY", "Other Item")
For i = LBound(Ay) To UBound(Ay)
If Ay(i) Like "*" & a & "*" Then
ReDim Preserve Ar(s)
Ar(s) = Array("P" & s + 1, Ay(i))
Ay(i) = ""
s = s + 1
ElseIf a = "Other Item" And Ay(i) <> "" Then
ReDim Preserve Ar(s)
Ar(s) = Array("P" & s + 1, Ay(i))
s = s + 1
End If
Next
Next
[A8:B65536] = ""
[A8].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
End Sub

複製代碼

學海無涯_不恥下問

TOP

b9208

中學生 Rank: 2

帖子: 182
主題: 34
精華: 0
積分: 316
點名: 0
作業系統: Win 7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-5-2
最後登錄: 2023-6-24

6^#

發表於 2010-5-28 13:52 | 只看該作者

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2010-5-28 16:00 | 只看該作者

回復 6# b9208

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

學海無涯_不恥下問

TOP

b9208