- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 2# mhl9mhl9
11 因為 filesearch 在excel2007不再可用,所以本文件不能在2007excel使用
可以打開本文件,但"文件列表"失效.
12 如果不用 filesearch,而改用Dir(),excel2007就可以用了.我試過Dir(),但抽取多層子資料夾
文件不理想,本質還是學得不夠.一知半解吧.
2007 可試試看 CreateObject("Scripting.FileSystemObject")- Option Explicit
- Dim Fs As Object, Sh As Worksheet, d As Object
- Sub iMain_Ex()
- Dim xlFileDialog As FileDialog
- Set xlFileDialog = Application.FileDialog(msoFileDialogFolderPicker) '開啟資料夾的對話框
- If xlFileDialog.Show = True Then '對話框: 有按下確定
- Application.ScreenUpdating = False
- Set Sh = Sheet1
- Set Fs = CreateObject("Scripting.FileSystemObject") '系統檔案物件: 提供對電腦檔案系統的存取
- Set d = CreateObject("Scripting.dictionary") '字典物件
- With Sh.UsedRange
- .Clear
- .Range("a1").Resize(, 7) = Array("路徑", "文件名", "副檔名", "文件長度", "建檔日期", "存檔日期", "註解")
- .Range("A1:F1").Font.Bold = True
- .Range("A1:F1").HorizontalAlignment = xlCenter
-
- 資料夾_副程式 xlFileDialog.SelectedItems(1)
-
- .Columns("D:D").NumberFormatLocal = "#,### ""KB"""
- .Columns("E:F").NumberFormatLocal = "yyyy-mm-dd"
- End With
- Application.ScreenUpdating = True
- End If
- End Sub
- Private Sub 資料夾_副程式(資料夾 As String)
- Dim f As Object
- For Each f In Fs.GetFolder(資料夾).Files 'Files(物件):檔案集合
- With Sh.[A1].End(xlDown).End(xlDown).End(xlUp).Offset(1)
-
- 檔案物件_副程式 f, .Cells
-
- ' .Range("a1") = f.ParentFolder
- ' .Range("b1") = f.Name
- ' .Hyperlinks.Add Anchor:=.Range("b1"), Address:=f
- ' .Range("c1") = Fs.GetExtensionName(f) ''Mid(F.Name, InStr(F.Name, ".") + 1)
- ' .Range("d1") = f.Size / 1024
- ' .Range("e1") = f.DateCreated
- ' .Range("F1") = f.DateLastAccessed
-
- 字典物件_副程式 f, .Range("b1")
- ' If d.Exists(F.Name) Then
- ' Set d(F.Name) = Union(d(F.Name), .Range("b1"))
- ' d(F.Name).Interior.ColorIndex = 40
- ' Else
- ' Set d(F.Name) = .Range("b1")
- 'End If
-
- End With
- Next
- '********************************************
- '*** 如資料夾下有子資料夾 再呼叫這副.程式 ***
- '呼叫 程式本身的迴圈 ***
- '********************************************
- For Each f In Fs.GetFolder(資料夾).SubFolders 'SubFolders(物件):資料夾集合
- 資料夾_副程式 f & ""
- Next
- End Sub
- Private Sub 檔案物件_副程式(f As Object, Rng As Range)
- With Rng
- .Range("a1") = f.ParentFolder '傳回指定檔案或資料夾的父資料夾物件。
- .Range("b1") = f.Name
- .Hyperlinks.Add Anchor:=.Range("b1"), Address:=f
- .Range("c1") = Fs.GetExtensionName(f) '傳回檔案的副檔名
- .Range("d1") = f.Size / 1024
- .Range("e1") = f.DateCreated '檔案或資料夾的建立日期和時間
- .Range("F1") = f.DateLastAccessed '檔案最後一次存取指定檔案或資料夾的日期和時間
- End With
- End Sub
- Private Sub 字典物件_副程式(f As Object, Rng As Range)
- If d.Exists(f.Name) Then
- Set d(f.Name) = Union(d(f.Name), Rng)
- d(f.Name).Interior.ColorIndex = 40
- Else
- Set d(f.Name) = Rng
- End If
- End Sub
|
|
發表於 2014-10-21 10:50
| 
