如何用VBA判断指定文件夹最后修改日期是否与当前日期匹配

我们在原有代码基础上新增了前置校验分支，核心逻辑为：

• 先校验源文件夹是否存在，避免非法路径导致运行报错
• 提取源文件夹的最后修改日期，与系统当日日期做匹配
• 仅匹配通过后才执行原有文件复制逻辑，匹配失败直接终止运行并提示

Sub sbCopyingAFile()

'声明变量
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
Dim sourceFolder As Object ' 新增：用于存储源文件夹对象

'你需要复制的目标文件名
sFile = "testfile.xlsx"

'修改为你的源文件夹路径
sSFolder = "C:\Dropbox (###)\BD SQL\"

'修改为你的目标文件夹路径
sDFolder = "C:\Dropbox (###)\BD SQL\testpath\"

'创建文件系统对象
Set FSO = CreateObject("Scripting.FileSystemObject")

'========== 新增：前置校验逻辑 开始 ==========
'先校验源文件夹是否存在
If Not FSO.FolderExists(sSFolder) Then
    MsgBox "指定的源文件夹不存在，请检查路径配置", vbCritical, "路径错误"
    Exit Sub
End If

'获取源文件夹对象，提取最后修改日期，仅匹配日期部分忽略时间
Set sourceFolder = FSO.GetFolder(sSFolder)
If DateValue(sourceFolder.DateLastModified) <> Date Then
    MsgBox "源文件夹当日无更新，无需执行文件复制操作", vbInformation, "校验未通过"
    Exit Sub
End If
'========== 新增：前置校验逻辑 结束 ==========

'校验源文件夹中是否存在目标文件
If Not FSO.FileExists(sSFolder & sFile) Then
    MsgBox "未找到指定文件", vbInformation, "文件不存在"
    
'校验目标文件夹中不存在同名文件时执行复制
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
    FSO.CopyFile sSFolder & sFile, sDFolder, True
    MsgBox "指定文件复制成功", vbInformation, "操作完成"
Else
    MsgBox "目标文件夹中已存在同名文件", vbExclamation, "文件已存在"
End If

Debug.Print sSFolder & sFile

End Sub

• 如果你需要将校验精度提高到小时/分钟级别，只需要删除DateValue()封装，直接对比sourceFolder.DateLastModified和Now()即可
• 原有文件判断、复制逻辑完全保留，新增校验不会影响原有业务逻辑的运行结果
• 所有弹窗提示内容可以根据你的实际需求自行调整文案

内容的提问来源于stack exchange，提问作者bgado