根据日期范围对文件进行计数(取决于修改的日期)

时间:2019-06-10 17:43:47

标签: excel vba

我在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

我希望能够对日期范围之间的所有文件进行计数,并显示文件的数量和计数。

0 个答案:

没有答案