如何比较文件夹的最后修改日期是否与当前日期匹配？ VBA

Question

我有一个程序会在文件夹中查找特定文件，如果存在，它将将该文件复制到指定的文件路径中。我想更进一步，采用我当前的代码并在它之前进行检查。此检查将查看指定文件夹并确定它的最后修改日期是否与今天的日期匹配。如果指定文件夹的最后修改日期与当前日期匹配，我希望代码进入该文件夹，然后执行当前代码。

Sub sbCopyingAFile()

'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String

'This is Your File Name which you want to Copy
sFile = "testfile.xlsx"

'Change to match the source folder path
sSFolder = "C:\Dropbox (###)\BD SQL\"

'Change to match the destination folder path
sDFolder = "C:\Dropbox (###)\BD SQL\testpath\"

'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "Specified File Not Found", vbInformation, "Not Found"
    
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile (sSFolder & sFile), sDFolder, True
    MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
    MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If

Debug.Print (sSFolder & sFile)

End Sub

Answer 1

请尝试下一个功能：

Function GetDateLastModif(strFold As String) As Date
   Dim fso As Object, gf As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set gf = fso.GetFolder(strFold)
   GetDateLastModif = gf.DateLastModified
End Function

可以这样测试：

Debug.Print GetDateLastModif(ThisWorkbook.path) 'with or without the ending backslash

或者，已经拥有fso 对象，您可以在现有代码中使用GetFolder：

     Dim gf As Object, d As Date
     Set gf = fso.GetFolder(sSFolder)
     d = gf.DateLastModified
     If DateSerial(Year(d), month(d), Day(d)) = Date Then
        'do whatever you need...
     End If

你也可以使用下一个（更简单的）方式：

    If CLng(cg.DateLastModified) = Date Then 'eliminate the decimals!
        'do what you want
     End If

但最优雅的解决方案是直接比较它们。基于DateLastModified 不能是未来的日期这一事实。由于小时：分钟：秒“贡献”，它将（就Single/Double 值而言）大于或等于当前日期...

     If gf.DateLastModified >= Date Then  
         'do what you need...
     End If