excel - 根据修改日期从日期范围计数文件

Question

我在 A 列中有一个文件路径，并且想要显示日期范围之间有多少文件的计数，如果有任何文件，我希望能够在显示文件名和日期的单元格上发表评论。

我有一个获得帮助的代码，但是当代码运行时，它会计算文件夹中的所有文件，并且注释只出现在列中的最后一个数字上。

Sub CreateMouseoverList(Optional FileFilter As String, Optional LowDate As Date, Optional HighDate As Date)

    Dim Cell    As Range
    Dim Ext     As Variant
    Dim File    As Object
    Dim FileCnt As Long
    Dim Files   As Object
    Dim Folder  As Variant
    Dim Item    As Variant
    Dim List()  As Variant
    Dim MaxLen  As Long
    Dim ModDate As Date
    Dim m       As Long
    Dim n       As Long
    Dim Note    As Comment
    Dim Text    As String

        If IsMissing(FileFilter) Then FileFilter = "*.*"

        ' // Is there is no LowDate then use 1.
        If LowDate = 0 Then LowDate = 2

        ' // If there is no HighDate then use today's date.
        If HighDate = 0 Then HighDate = Now()

        With CreateObject("Shell.Application")
            For Each Cell In Range("A1", Cells(Rows.count, "A").End(xlUp))
                FileCnt = 0
                ReDim List(1 To 1)

                Set Note = Cell.Offset(0, 1).Comment
                If Note Is Nothing Then Set Note = Cell.Offset(0, 1).AddComment

                Note.Shape.TextFrame.Characters(1, Len(Note.Text)).Delete
                Note.Shape.TextFrame.Characters.Font.FontStyle = "regular"

                Set Folder = .Namespace(Cell.Value)

                If Not Folder Is Nothing Then
                    Set Files = Folder.Items

                    For Each Ext In Split(FileFilter, ";")
                        Files.Filter 64, Ext

                        Text = vbLf & " " & Ext & " Files | " & vbLf

                        List(UBound(List)) = Text
                        n = UBound(List) + 1
                        ReDim Preserve List(1 To n)

                        Text = String(Len(Text), "-") & " | " & vbLf

                        List(UBound(List)) = Text
                        n = UBound(List) + 1
                        ReDim Preserve List(1 To n)

                        Note.Shape.TextFrame.Characters.Font.Name = "Courier New"
                        Note.Shape.TextFrame.AutoSize = True

                        For Each File In Files
                            ModDate = File.ModifyDate
                            If ModDate >= LowDate And HighDate <= HighDate Then
                                FileCnt = FileCnt + 1
                                Text = File.Name & " | " & ModDate & vbLf
                                List(n) = Text
                                n = UBound(List) + 1
                                ReDim Preserve List(1 To n)
                                If Len(Text) > MaxLen Then MaxLen = Len(Text)
                            End If
                        Next File
                    Next Ext

                    Cell.Offset(0, 1).Value = FileCnt
                Else
                    Cell.Offset(0, 1).Value = "Folder not found."
                End If
            Next Cell
        End With

        For Each Item In List
            m = Len(Item)
            n = Note.Shape.TextFrame.Characters.count + 1
            Item = Split(Item, "|")
            If UBound(Item) > -1 Then
                Text = Item(0) & String(MaxLen - m, 32) & Item(1)
                Note.Shape.TextFrame.Characters(n, Len(Text)).Insert Text
            End If
        Next Item

End Sub

Sub TestIt()
    Call CreateMouseoverList("*.txt;*.xls", "4/1/2019","6/10/2019")
End Sub

我希望能够计算日期范围内的所有文件并显示文件的内容和数量。

标签： excelvba