How to Get UTC of file DateLastModified in VBA? - vba

Question

I need to find from an Access DB if any file in a folder got changed. For this reason I created a table containing the file information (name and DateLastModified). However there is the problem, that Windows always adjusts the DateLastModified to the local time zone and this value will even change on daylight savings (means: DateLastModified will change when DST activates/deactivates)!
To overcome this and to find the files true 'DateLastModified'-date I use FileSystemObject to get 'DateLastModified' and convert the returned value to UTC by means of Function GetUTC. Then I store this value in the database. I carefully tested GetUTC - it will return a value not depending on DST (tested for time zones CET and CEST).
Re-querying the folder and comparing a newly calculated 'DateLastModified' against the stored 'DateLastModified' will fail for approximately 15%-35% of the files - is seems random which files fail! Could it be that DT.GetVarDate(False) in GetUTC does not always return the same binary value?
However using debug.print always shows the same Date & Time for the failing files and the value stored in the database! MS specs says the resolution of datatype 'Date' is one second. So I do not understand how 2 Dates that show the same value will result to false when compared! Sample output of a failed file:
1477 493 18.12.2013 19:03:26 18.12.2013 19:03:26 scanColor0010.pdf
How can I make this work?
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

Answer 1

Rewrite
If (rst!fileDateModified = GetUTC(f.DateLastModified)) Then
'Ok, this is always expected
Else
to
If Datediff("s",rst!fileDateModified,GetUTC(f.DateLastModified)) = 0 Then
'Ok, this is always expected
Else
Further reading on Datediff
Further reading on How to store, calculate, and compare Date/Time data in Microsoft Access. Although this article is on Access it should be similar in Excel