这是我第一次提出问题,所以希望我遵循协议。这是参考“获取 vba 中的子目录列表”获取 vba 中的子目录列表。
我发现 Brett 的示例 #1 - Using FileScriptingObject 最有帮助。但是我在结果中还需要一个数据元素 (DateLastModified)。我试图修改代码,但不断收到无效的限定符错误。以下是我所做的代码修改:
- Range("A1:C1") = Array("文件名", "路径", "上次修改日期")。
- Do While 循环添加了这个 => Cells(i, 3) = myFile.DateLastModified。
将不胜感激包括“上次修改日期”的帮助。
这里的 Santosh 是完整的代码,带有指示修改的注释。
Public Arr() As String
Public Counter As Long
Sub LoopThroughFilePaths()
Dim myArr
Dim i As Long
Dim j As Long
Dim MyFile As String
Const strPath As String = "c:\temp\"
myArr = GetSubFolders(strPath)
Application.ScreenUpdating = False
'Range("A1:B1") = Array("text file", "path")' <= orig code
Range("A1:C1") = Array("text file", "path", "Date Last Modified") ' <= modified code
For j = LBound(Arr) To UBound(Arr)
MyFile = Dir(myArr(j) & "\*.txt")
Do While Len(MyFile) <> 0
i = i + 1
Cells(i, 1) = MyFile
Cells(i, 2) = myArr(j)
Cells(i, 3) = MyFile.DateLastModified ' <= added to modify code
MyFile = Dir
Loop
Next j
Application.ScreenUpdating = True
End Sub
Function GetSubFolders(RootPath As String)
Dim fso As Object
Dim fld As Object
Dim sf As Object
Dim myArr
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(RootPath)
For Each sf In fld.SubFolders
Counter = Counter + 1
ReDim Preserve Arr(Counter)
Arr(Counter) = sf.Path
myArr = GetSubFolders(sf.Path)
Next
GetSubFolders = Arr
Set sf = Nothing
Set fld = Nothing
Set fso = Nothing
End Function