|
试试看
- '需要添加引用:Microsoft Scripting runtime
- Sub kong()
- Dim fs As New FileSystemObject, i, j, k
- Dim fd, subfd As Folder
- Dim ar, br
- Dim wb As Workbook, wk As Workbook
- Set wb = ThisWorkbook
- Dim files As file
- Set fp = Application.FileDialog(msoFileDialogFolderPicker) '选择需要查询文件的文件夹
- fp.Show
- Set paths = fp.SelectedItems
- ReDim arr(1)
- arr(0) = paths(1) '文件夹路径赋给数组
- ActiveSheet.Cells.ClearContents
- Application.ScreenUpdating = False
- Do Until i > k
- Set fd = fs.GetFolder(arr(i))
- For Each files In fd.files
- j = j + 1
- '文件名 A列
- ActiveSheet.Range("a" & j + 1) = files.Name
- '文件绝对路径 B列
- ActiveSheet.Range("b" & j + 1) = files.Path
- Next
- For Each subfd In fd.SubFolders
- k = k + 1
- ReDim Preserve arr(k + 1)
- arr(k) = subfd '将子文件夹赋给数组
- Next
- i = i + 1
- Loop
- Dim h2
- h2 = ActiveSheet.Cells(Rows.Count, "a").End(3).Row
- '文件夹绝对路径 B列文件绝对路径下面
- ActiveSheet.Range("b" & h2 + 1 & ":b" & h2 + UBound(arr)) = Application.Transpose(arr)
- End Sub
复制代码 |
|