时间戳

首页 > 解决方案 > 如何在 VBA 中获取文件 DateLastModified 的 UTC？

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

问题描述

如果文件夹中的任何文件被更改，我需要从 Access DB 中查找。为此，我创建了一个包含文件信息（名称和 DateLastModified）的表。但是有一个问题，Windows 总是将 DateLastModified 调整到本地时区，这个值甚至会在夏令时发生变化（意味着：DateLastModified 会在 DST 激活/停用时发生变化）！

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

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

然而，使用 debug.print 总是为失败的文件显示相同的日期和时间以及存储在数据库中的值！MS规范说数据类型“日期”的分辨率是一秒。所以我不明白显示相同值的 2 个日期在比较时如何导致错误！失败文件的示例输出：

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

标签： vbafilems-accessutcdst

解决方案

改写

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

至

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

进一步阅读Datediff

进一步阅读如何在 Microsoft Access 中存储、计算和比较日期/时间数据。虽然这篇文章是关于 Access 的，但它在 Excel 中应该是类似的

推荐阅读