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

时间:2014-03-28 08:48:04

标签: excel file vba search excel-vba

有人可以告诉我,用户是否可以在输入框中输入两个单独的日期,然后在文件夹中搜索(理想情况下)创建日期介于输入日期之间的文件?

我可以搜索文件夹中的文件,但文件数量每天都在增加,搜索所有文件的时间越来越长。我希望如果用户可以选择日期范围,那么这将缩短运行时间。

如果根本不可能,可以设置一个宏来搜索最近创建的文件夹STARTING中的文件,然后从那里开始工作吗?

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

1 个答案:

答案 0 :(得分:1)

添加到您的昏暗部分:

Dim oFile

在循环之前添加:

Set oFile = CreateObject("Scripting.FileSystemObject")

在打开文件之前的循环中添加一个if语句:

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

您还可以使用oFile.getFile(目录和文件名).DateLastModified - 如果您想使用文件的最后更改日期而不是创建日期。