我在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
我希望能够对日期范围之间的所有文件进行计数,并显示文件的数量和计数。