VBA_建立檔案目錄

使用VBA抓取檔案路徑中的清單，用在交接把自己手上檔案移交給人時很好用，當然你從人家手上接到檔案，如果沒清單時也很好用。

Sub A0_檔案清單_DIC()

Application.ScreenUpdating = False

' 比ARR慢一點點

t = Timer

Dim DIC

Set DIC = CreateObject("scripting.dictionary")

Range("A:L").ClearContents

'n = 0

Range("A1").Resize(, 8) = Array("檔名", "路徑", "大小", "修改時間", "建立時間", "授權時間", "資料夾", "檔案格式")

Dim strPath As String

strPath = "D:\稽核工作" '修改這裡

Dim OBJ As Object, Folder As Object, File As Object

Set OBJ = CreateObject("Scripting.FileSystemObject")

Set Folder = OBJ.GetFolder(strPath)

Call ListDIC(Folder, DIC)

Dim SubFolder As Object

For Each SubFolder In Folder.SubFolders '子資料夾

    Call ListDIC(SubFolder, DIC)

    Call GetSubFolders(SubFolder, DIC)

Next SubFolder

Range("A2").Resize(DIC.Count, 8) = Application.Transpose(Application.Transpose(DIC.Items))

MsgBox Timer - t

DIC.RemoveAll

End Sub

'---------------------------------------------------------------------------------------------------------

Sub ListDIC(ByRef Folder As Object, DIC)

For Each File In Folder.Files'擷取的內容

        DIC(File.Path) = Array(File.Name, File.Path, (File.Size / 1024), File.DateLastModified, _

            File.DateCreated, File.DateLastAccessed, Split(File.ShortPath, "\" & File.Name)(0), File.Type)

Next File

End Sub

'------------------------------------------------------------------------

Sub GetSubFolders(ByRef SubFolder As Object, DIC)

Dim FolderItem As Object '資料夾

For Each FolderItem In SubFolder.SubFolders

    Call ListDIC(FolderItem, DIC)

    Call GetSubFolders(FolderItem, DIC)   '這個方式沒使用過

Next FolderItem

End Sub