Sub 提取文件名()
Dim myPath As String
Dim myFile As String文件名提取
myPath = ActiveCell.FormulaR1C1  'Cells(1, 7)
n = ActiveCell.Row
myFile = Dir(myPath & "\*.*")
Do While myFile <> ""
Selection.Insert Shift:=xlDown
Cells(n, 1) = myFile
Cells(n, 2) = FileDateTime(myPath & "\" & myFile)
myFile = Dir
n = n + 1
Loop
End Sub
========================================================================
Sub 批量提取文件夹名()
Dim fs As Object
Dim myPath As String
n = ActiveCell.Row
myPath = ActiveCell.FormulaR1C1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder(myPath)
For Each fd In f.subfolders
Cells(n, 3) = myPath & fd.Name
Selection.Insert Shift:=xlDown
n = n + 1
Next
Set f = Nothing
Set fs = Nothing
End Sub