会python真的可以为所欲为0(回)
350天前
这里还有人吗1(回)
535天前这里还有人吗0(回)
535天前
每天面对着电脑屏幕，敲打键盘。我所面对的并不只是代码，而是一种生活方式。0(回)
760天前到处都是羊，不想上班0(回)
840天前
鸽子
0(回)
844天前FileSearch 物件已從 2007 Microsoft Office 程式中去除(這麼好用的功能也拿掉了，真是給他..00XX)，詳細的說明請參考 |
KB935402說明，在說明中微軟有提示可以使用Dir 函式或 FileSystemObject |
類別來搜索檔案，今天就依這個提示來做一個類似Application.FileSearch的功能，可以設定是否搜尋子資料夾，詳細說明請參考程式碼…. |
Dim strArr() As String, rCount As Integer |
Sub App_FileSearch() |
'設定要搜尋檔案的關鍵字 |
'如果要列出所有檔案請設定為String = "" |
Const keyword As String = "*.xls" '搜尋xls檔案 |
'App_SearchSubFolder(keyword, True) '搜尋包含子資料夾 |
'App_SearchSubFolder(keyword, False) '搜尋不包含子資料夾 |
Call App_SearchSubFolder(keyword, True) |
If UBound(strArr) > 0 Then |
'以超連結的方式列出檔案 |
For i = 0 To UBound(strArr) |
If strArr(i) <> "" Then |
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 3, "A"), _ |
Address:=strArr(i), TextToDisplay:=strArr(i) |
End If |
Next i |
Else |
MsgBox "未發現檔案" |
End If |
End Sub |
Function App_SearchSubFolder(keyword As String, rSearchSubFolders As Boolean) |
Dim fd As Object |
Dim fso As Object |
Set fso = CreateObject("Scripting.FileSystemObject") |
'開啟Excel內建的資料夾瀏覽方塊 |
Set fd = Application.FileDialog(msoFileDialogFolderPicker) |
If fd.Show = -1 Then |
rLookIn = fd.SelectedItems(1) |
Else |
MsgBox "未選取資料夾": Exit Function |
End If |
rFilename = Dir$(rLookIn & "\" & keyword) |
rCount = 0 |
'建立動態陣列 |
ReDim Preserve strArr(rCount) |
'第一階資料夾 |
Do While rFilename <> vbNullString |
strArr(rCount) = rLookIn & "\" & rFilename |
rCount = rCount + 1 |
ReDim Preserve strArr(rCount) |
rFilename = Dir$() |
Loop |
If rSearchSubFolders Then '判斷是否搜尋子資料夾 |
'搜尋第二階以後的子資料夾 |
Call App_NextSubFolder(fso.GetFolder(rLookIn), keyword) |
End If |
Set fd = Nothing |
Set fso = Nothing |
End Function |
Private Sub App_NextSubFolder(ByRef Folder As Object, _ |
ByRef keyword As String) |
Dim SubFolder As Object |
For Each SubFolder In Folder.SubFolders |
rFilename = Dir$(SubFolder.Path & "\" & keyword) |
Do While rFilename <> vbNullString |
strArr(rCount) = SubFolder.Path & "\" & rFilename |
rCount = rCount + 1 |
ReDim Preserve strArr(rCount) |
rFilename = Dir$() |
Loop |
Call App_NextSubFolder(SubFolder, keyword) |
Next |
End Sub |
