如何在VBA中获取文件DateLastModified的UTC？

我需要从Access数据库中查找文件夹中的任何文件是否已更改。因此，我创建了一个包含文件信息（名称和DateLastModified）的表。但是有一个问题，Windows总是将DateLastModified调整为本地时区，该值甚至会在夏令时更改（意味着：DateLastModified将在DST激活/停用时更改）

为了克服这一问题并找到文件true'DateLastModified'-date，我使用FileSystemObject获取'DateLastModified'，并通过函数GetUTC将返回值转换为UTC。然后我将这个值存储在数据库中。我仔细测试了GetUTC-它将返回一个不依赖于DST的值（针对时区CET和CEST进行测试）

重新查询文件夹，并将新计算的“DateLastModified”与存储的“DateLastModified”进行比较，大约15%-35%的文件将失败-哪些文件失败似乎是随机的！是否GetUTC中的DT.GetVarDate（False）并不总是返回相同的二进制值

但是，使用debug.print时，失败文件和数据库中存储的值始终显示相同的日期和时间！MS specs表示，数据类型“日期”的分辨率为1秒。因此，我不明白两个显示相同值的日期在比较时如何会导致错误！失败文件的示例输出：

1477   493   18.12.2013 19:03:26   18.12.2013 19:03:26   scanColor0010.pdf

我怎样才能做到这一点

Option Compare Database
Option Explicit

Public ws As Workspace
Public db As Database

Function GetUTC(dLocalTimeDate As Date) As Date
Dim DT As Object
Dim curTime As Date
  curTime = Now()
  Set DT = CreateObject("WbemScripting.SWbemDateTime")
  DT.SetVarDate curTime
  GetUTC = dLocalTimeDate - curTime + DT.GetVarDate(False)
End Function



'------------------------------------------------------------
' Test_UTC_Click
'
'------------------------------------------------------------
Private Sub Test_UTC_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim rst As Recordset
Dim fso As FileSystemObject
Dim f As File
Dim lngCountWrong As Long
Dim lngCount As Long

  Set ws = DBEngine.Workspaces(0)
  Set db = CurrentDb()

  RecursiveDir colFiles, "Y:\", "*.pdf", False
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each vFile In colFiles
    Set f = fso.GetFile(vFile)
    Set rst = db.OpenRecordset("SELECT tblFiles.*, tblFiles.fileName FROM tblFiles WHERE (((tblFiles.fileName)=""" & f.Name & """));")
    rst.MoveFirst
    lngCount = lngCount + 1
    If (rst!fileDateModified = GetUTC(f.DateLastModified)) Then
      'Ok, this is always expected
    Else
      'Uuuups - what went wrong?
      lngCountWrong = lngCountWrong + 1
      Debug.Print lngCount, lngCountWrong, rst!fileDateModified, GetUTC(f.DateLastModified), f.Name
    End If
    rst.Close
    Set f = Nothing
    DoEvents
  Next vFile
  Debug.Print "finished", lngCount
  Set fso = Nothing
End Sub


'------------------------------------------------------------
' CreateTestdata_Click
'
'------------------------------------------------------------
Private Sub CreateTestdata_Click()
Dim colFiles As New Collection
Dim vFile As Variant
Dim rst As Recordset
Dim fso As FileSystemObject
Dim f As File

  Set ws = DBEngine.Workspaces(0)
  Set db = CurrentDb()
  
  db.Execute "DELETE tblFiles.* FROM tblFiles;"
  Set rst = db.OpenRecordset("SELECT tblFiles.* FROM tblFiles;")
  
  RecursiveDir colFiles, "Y:\", "*.pdf", False
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each vFile In colFiles
    Set f = fso.GetFile(vFile)
    rst.AddNew
    rst!filename = f.Name
    Debug.Print f.Name
    rst!fileDateModified = GetUTC(f.DateLastModified)
    rst.Update
    Set f = Nothing
    DoEvents
  Next vFile
  Set fso = Nothing
  rst.Close
  Debug.Print "Finished creating"
  MsgBox "Finished creating"
End Sub

重写

   If (rst!fileDateModified = GetUTC(f.DateLastModified)) Then
      'Ok, this is always expected
    Else

到

进一步阅读

---

进一步阅读。虽然这篇文章在Access上，但它在Excel中应该类似

可能是浮点问题。我应用了此修补程序。这大大改善了行为！不过，还有一（1）个文件，现在显示每个调用的时间差为1秒！我循环了这个文件的代码，每个50000次调用都有1秒的差异！有什么解释吗？--谢谢你的链接！在对这个问题投入了更多的时间之后，我认为现在出现的问题是由于这样一个事实：GetUTC也对日期进行算术：GetUTC=dLocalTimeDate-curTime+DT。GetVarDate（False）我也尝试用DateAdd/DateDiff解决这个问题，但遇到了类型转换问题。作为一种解决方法，我决定使用Abs（DateDiff（“s”，rst！fileDateModified，GetUTC（f.DateLastModified）），那么最好使用

Abs（rst！fileDateModified-GetUTC（f.DateLastModified）），谢谢。否。由于“GetUTC”有时返回秒差，因此阈值至少需要1秒。此外，过去在FAT、FAT32和NTFS之间复制文件时，通常会出现2秒钟的问题。不太可能有人修改文件并在2秒内将其保存回来（至少对于此处涉及的文件（.PDF收据），对于机器生成的日志可能不同…）。
   If Datediff("s",rst!fileDateModified,GetUTC(f.DateLastModified)) = 0 Then
      'Ok, this is always expected
    Else