File 如何在两个日期之间搜索文件？

有人能告诉我，用户是否可以在输入框中输入两个不同的日期，然后在文件夹中搜索包含（理想情况下）输入日期之间的创建日期的文件

我可以很好地搜索文件夹中的文件，但是文件的数量每天都在增加，搜索所有文件的时间越来越长。我希望，如果用户可以选择一个日期范围，那么这将减少运行时间

如果根本不可能，是否可以设置一个宏来搜索文件夹中的文件，从最近创建的文件开始，然后从那里返回

Sub UKSearch()

 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 'Search function to find specific consignment number from multiple intake sheets'
 'Used by Traffic Office                                                         '
 'Created by *********** 11/03/14     Password to unlock = *********             '
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim FSO As Object 'FileSystemObject
Set FSO = CreateObject("scripting.filesystemobject")
Dim Directory As String
Dim FileName As String
Dim varCellvalue As Long

Application.ScreenUpdating = False
MsgBox ("This may take a few minutes")

'value to be searched
varCellvalue = Range("D13").Value

'Change the directory below as needed
Directory = "\\*******\shared$\Common\Returns\*********\"
If Right(Directory, 1) <> "\" Then
   Directory = Directory & "\"
End If

'Search for all files in the directory with an xls* file type.
FileName = Dir(Directory & "*.xls*")

''''''''''''''''''''''''
 'Opens, searches through and closes each file
 Do While FileName <> ""
 OpenFile = Directory & FileName
 Workbooks.Open (OpenFile)

Workbooks(FileName).Activate

'Count through all the rows looking for the required number
ActiveWorkbook.Sheets("UK Scan Sheet").Activate
LastRow = Range("B65536").End(xlUp).Row

intRowCount = LastRow

Range("B1").Select

For i = 1 To intRowCount
    'If the required number is found then select it and stop the search
   If ActiveCell.Value = varCellvalue Then
       GoTo Finish
       Else
   End If
ActiveCell.Offset(1, 0).Select
Next i

Workbooks(FileName).Close
FileName = Dir
OpenFile = ""
 Loop
 ''''''''''''''''''''''''''

Finish:

Application.ScreenUpdating = False

End Sub

Sub-UKSearch（）
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'从多张进口单中查找特定托运编号的搜索功能'
“交通办公室使用”
'由**********11/03/14创建要解锁的密码=***********'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
将FSO设置为对象的FileSystemObject
设置FSO=CreateObject（“scripting.filesystemobject”）
将目录设置为字符串
将文件名设置为字符串
Dim varcell值为Long
Application.ScreenUpdating=False
MsgBox（“这可能需要几分钟”）
'要搜索的值
varCellvalue=范围（“D13”）.值
'根据需要更改下面的目录
Directory=“\******\shared$\Common\Returns\********”
如果正确（目录，1）“\”则
目录=目录&“\”
如果结束
'搜索目录中具有xls*文件类型的所有文件。
FileName=Dir（目录&“*.xls*”）
''''''''''''''''''''''''
'打开、搜索和关闭每个文件
文件名“”时执行此操作
OpenFile=目录和文件名
工作簿.打开（OpenFile）
工作簿（文件名）。激活
'对所有行进行计数，以查找所需的数字
ActiveWorkbook.Sheets（“英国扫描表”）。激活
LastRow=范围（“B65536”）。结束（xlUp）。行
intRowCount=LastRow
范围（“B1”）。选择
对于i=1，输入计数
'如果找到所需号码，则选择该号码并停止搜索
如果ActiveCell.Value=varCellvalue，则
转到终点
其他的
如果结束
ActiveCell.Offset（1，0）。选择
接下来我
工作簿（文件名）。关闭
FileName=Dir
OpenFile=“”
环
''''''''''''''''''''''''''
完成：
Application.ScreenUpdating=False
端接头

添加到dim部分：

Dim oFile

在循环之前添加：

Set oFile = CreateObject("Scripting.FileSystemObject")

在打开文件之前，在循环中添加if语句：

if oFile.getFile(Directory & FileName).DateCreated >= EarliestDate and oFile.getFile(Directory & FileName).DateCreated <= LatestDate

---

如果oFile.getFile（目录和文件名）.DateCreated>=EarliestDate和oFile.getFile（目录和文件名）.DateCreated我不确定您的目标是什么，但如果您试图获取文件名的日期筛选集合，您可能会从中得到一些启发？您可以查看以下关于如何确定创建日期的答案：。尝试将其纳入您的代码中，如果您遇到问题，请发回，我们会帮助您。我会尽量更清楚一点：-我想做的是-用户按下命令按钮-日期输入框（YY-MM-DD）-第二个日期输入框（YYYY-MM-DD）-搜索值输入框-宏在两个输入日期之间查找文件夹中的第一个文件-宏在该文件中搜索搜索值-如果未找到，则移动到下一个文件，直到到达两个输入日期之间的最后一个文件。我希望这能让我更清楚地知道我想做什么？一切都很清楚，但你应该告诉我们到目前为止你尝试了什么，你在哪里卡住了。我添加了我的代码，因为我说它只是在搜索每个文件，直到匹配为止，我想缩小文件的范围。