Подсчет файла из диапазона дат в зависимости от даты изменения - PullRequest
0 голосов
/ 10 июня 2019

У меня есть путь к файлу в столбце 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

Я хотел бы иметь возможность подсчитать все файлы, которые находятся в диапазоне дат, и показать, что это за файлы, а также их количество.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...