简体   繁体   English

Excel VBA使用FileSystemObject列出文件的最后修改日期

[英]Excel VBA using FileSystemObject to list file last date modified

this is my first time asking question so hopefully I'm following protocol. 这是我第一次提问,所以希望我遵守协议。 This is in reference to "get list of subdirs in vba" get list of subdirs in vba . 这是参考“获取vba 中的子目录列表获取 vba 中的子目录列表

I found Brett's example #1 - Using FileScriptingObject most helpful. 我找到了Brett的例子#1 - 使用FileScriptingObject最有帮助。 But there's one more data element (DateLastModified) I need in results. 但是在结果中还需要一个数据元素(DateLastModified)。 I tried to modify the code but keep getting invalid qualifier error. 我试图修改代码,但一直得到无效的限定符错误。 Here are code modifications I made: 以下是我做的代码修改:

  1. Range("A1:C1") = Array("File Name", "Path", "Date Last Modified"). 范围(“A1:C1”)=数组(“文件名”,“路径”,“上次修改日期”)。
  2. Do While loop added this => Cells(i, 3) = myFile.DateLastModified. Do while循环添加了这个=> Cells(i,3)= myFile.DateLastModified。

Will appreciate help to include the "Date Last Modified". 将非常感谢帮助包括“上次修改日期”。

Santosh here is complete code with comments indicating modifications. 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  

Try this code : 试试这段代码:

Sub ListFilesinFolder()

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File

    SourceFolderName = "C:\Users\Santosh"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    Range("A1:C1") = Array("text file", "path", "Date Last Modified")

    i = 2
    For Each FileItem In SourceFolder.Files
        Cells(i, 1) = FileItem.Name
        Cells(i, 2) = FileItem
        Cells(i, 3) = FileItem.DateLastModified
        i = i + 1
    Next FileItem

    Set FSO = Nothing

End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM