Set Date/Time validation rule in Access 2019+

Question

I am entering flights into a table with Depart Date/Time and Arrive Date/Time. To ensure that the arrive date/time is always later than the depart date/time, I setup this table validation rule: [ArriveDateTime]>[DepartDateTime]. But when flying from Iceland to North America, it is possible that a flight could actually arrive slightly earlier than it departs. Is there any way to override a table validation rule? If not, then any suggestion for a validation rule that would allow an arrive date/time of up to 30 min earlier that the depart date/time would be appreciated.

Converting to UTC date/time would solve your problem but you would need to take time zone into consideration. That could get tricky. Have a look here: https://stackoverflow.com/questions/1600875/how-to-get-the-current-datetime-in-utc-from-an-excel-vba-macro — BobS, Jun 22 '23 at 23:47

score 0 · Answer 1 · answered Jun 23 '23 at 09:30

You must observe the timezones of the flight dates. As a minimum, you can take advantage of those options ready at hand in Windows.

How to do this is described in my articles:

Time Zones, Windows, and VBA - Part 1 and

Time Zones, Windows, and Microsoft Office - Part 2

and at my repository at GitHub: VBA.Timezone-Windows.

Full code is way too much to post here, but here is one of the core functions:

' Returns the timezone bias as specified in Windows from
' the name (key) of a timezone entry in the Registry.
' Accepts values without the common trailing "Standard Time".
'
' If Dst is true, and the current date is within daylight saving time,
' bias for daylight saving time is returned.
' If Date1 is specified, the bias of that date is returned.
'
' Returns a bias of zero if a timezone is not found.
'
' Examples:
'   Bias = BiasWindowsTimezone("Argentina")
'   Bias -> 180     ' Found
'
'   Bias = BiasWindowsTimezone("Argentina Standard Time")
'   Bias -> 180     ' Found.
'
'   Bias = BiasWindowsTimezone("Germany")
'   Bias -> 0       ' Not found.
'
'   Bias = BiasWindowsTimezone("Western Europe")
'   Bias -> 0       ' Not found.
'
'   Bias = BiasWindowsTimezone("W. Europe")
'   Bias -> -60     ' Found.
'
'   Bias = BiasWindowsTimezone("Paraguay", True, #2018-07-07#)
'   Bias -> 240     ' Found.
'
'   Bias = BiasWindowsTimezone("Paraguay", True, #2018-02-11#)
'   Bias -> 180     ' Found. DST.
'
'   Bias = BiasWindowsTimezone("Paraguay", False, #2018-02-11#)
'   Bias -> 240     ' Found.
'
' 2018-11-16. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function BiasWindowsTimezone( _
    ByVal TimezoneName As String, _
    Optional Dst As Boolean, _
    Optional Date1 As Date) _
    As Long
    
    Static Entries()    As TimezoneEntry
    Static LastName     As String
    Static LastYear     As Integer
    
    Static Entry        As TimezoneEntry
    Dim ThisName        As String
    Dim ThisYear        As Integer
    Dim StandardDate    As Date
    Dim DaylightDate    As Date
    Dim DeltaBias       As Long
    Dim Bias            As Long
    
    If Trim(TimezoneName) = "" Then
        ' Nothing to look up.
        Exit Function
    Else
        ThisName = Trim(TimezoneName)
        ThisYear = Year(Date1)
        If LastName = ThisName And LastYear = ThisYear Then
            ' Use cached data.
        Else
            ' Retrieve the single entry or - if not found - an empty entry.
            Entries = RegistryTimezoneItems(ThisName, (ThisYear))
            Entry = Entries(LBound(Entries))
            LastName = ThisName
            LastYear = ThisYear
        End If
        If _
            StrComp(Entry.Name, TimezoneName, vbTextCompare) = 0 Or _
            StrComp(Replace(Entry.Name, StandardTimeLabel, ""), TimezoneName, vbTextCompare) = 0 Then
            ' Windows timezone found.
            
            ' Default is standard bias.
            DeltaBias = Entry.Tzi.StandardBias
            If Dst = True Then
                ' Return daylight bias if Date1 is of daylight saving time.
                StandardDate = DateSystemTime(Entry.Tzi.StandardDate)
                DaylightDate = DateSystemTime(Entry.Tzi.DaylightDate)
                
                If DaylightDate < StandardDate Then
                    ' Northern Hemisphere.
                    If DateDiff("s", DaylightDate, Date1) >= 0 And DateDiff("s", Date1, StandardDate) > 0 Then
                        ' Daylight time.
                        DeltaBias = Entry.Tzi.DaylightBias
                    Else
                        ' Standard time.
                    End If
                Else
                    ' Southern Hemisphere.
                    If DateDiff("s", DaylightDate, Date1) >= 0 Or DateDiff("s", Date1, StandardDate) > 0 Then
                        ' Daylight time.
                        DeltaBias = Entry.Tzi.DaylightBias
                    Else
                        ' Standard time.
                    End If
                End If
                
            End If
            ' Calculate total bias.
            Bias = Entry.Bias + DeltaBias
        End If
    End If

    BiasWindowsTimezone = Bias

End Function

BobS · Answer 2 · 2023-06-24T23:15:33.260

Your question intrigued me so I set about putting some fully functional code together. I have tested this and it works very well. One of my tests involved going to the Qantas website and using the departure and arrival times from Sydney, Australia to Los Angeles. This was a good test in that it mimicked your Iceland scenario. You arrive in LA local time before you depart Sydney local time. From there I was able to calculate the actual travel time (13 hours and 45 minutes) which matched the Qantas website.

The code takes daylight saving time into account at both the departure and arrival time zones. To make this work seamlessly you will need to link your departure/arrival locations with their respective time zones. This would be best done in a table linked to your location master (I'm assuming there is one). I would not recommend that you put the full time zone information into a local table because daylight saving time rules tend to change and you would never be certain that your data was current. Microsoft incorporates these changes into their updates so it is safer to use the registry. You can retrieve all the time zone keys stored in the registry using the following code. You will obviously need to adjust it to your own requirements:

  Dim objReg     As Object, _
      strKeyPath As String, _
      strValue   As String, _
      varEntry   As Variant, _
      arrSubKeys As Variant

  ' Enumerate all time zone entries in the registry
  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
  objReg.EnumKey HKEY_LOCAL_MACHINE, strSubKey, arrSubKeys

  ' Put the time zone entries somewhere
  For Each varEntry In arrSubKeys
    objReg.GetStringValue HKEY_LOCAL_MACHINE, strSubKey & "\" & varEntry, "Display", strValue

    ... write the entries to a table
    ... - varEntry is the key to the registry and will be unique.
    ... - strValue is the display entry showing UTC offset and country/city name.

  Next
  
  Set objReg = Nothing

Create a new module and copy the following code into it:

'--------------------------------------------------
' Convert time zone local time to UTC
'
' Author: BobS
' In response to: John C
'                 https://stackoverflow.com/questions/76535823/set-date-time-validation-rule-in-access-2019
'
' References:
' https://learn.microsoft.com/en-us/windows/win32/api/timezoneapi/nf-timezoneapi-tzspecificlocaltimetosystemtime
'
' Parts of this code have been adapted from freely available code on the web.
' Credit for these parts must go to:
' Nayan Patel - https://binaryworld.net/Main/CodeDetail.aspx?CodeId=3633#copy
' tomasdeml - https://stackoverflow.com/questions/1600875/how-to-get-the-current-datetime-in-utc-from-an-excel-vba-macro
'--------------------------------------------------

Option Explicit

' Time zone information declarations
Private Type SYSTEM_TIME
  wYear         As Integer
  wMonth        As Integer
  wDayOfWeek    As Integer
  wDay          As Integer
  wHour         As Integer
  wMinute       As Integer
  wSecond       As Integer
  wMilliseconds As Integer
End Type

Private Type REG_TIME_ZONE_INFO
  Bias         As Long
  StandardBias As Long
  DaylightBias As Long
  StandardDate As SYSTEM_TIME
  DaylightDate As SYSTEM_TIME
End Type

Private Type TIME_ZONE_INFORMATION
  Bias                  As Long
  StandardName(0 To 63) As Byte             ' used to accommodate Unicode strings
  StandardDate          As SYSTEM_TIME
  StandardBias          As Long
  DaylightName(0 To 63) As Byte             ' used to accommodate Unicode strings
  DaylightDate          As SYSTEM_TIME
  DaylightBias          As Long
End Type

' Registry information declarations
Private Const REG_SZ = 1, _
              REG_BINARY = 3, _
              REG_DWORD = 4

Public Const HKEY_LOCAL_MACHINE = &H80000002

Private Const ERROR_SUCCESS = 0, _
              ERROR_BADDB = 1, _
              ERROR_BADKEY = 2, _
              ERROR_CANTOPEN = 3, _
              ERROR_CANTREAD = 4, _
              ERROR_CANTWRITE = 5, _
              ERROR_OUTOFMEMORY = 6, _
              ERROR_ARENA_TRASHED = 7, _
              ERROR_ACCESS_DENIED = 8, _
              ERROR_INVALID_PARAMETERS = 87, _
              ERROR_NO_MORE_ITEMS = 259

Private Const KEY_QUERY_VALUE = &H1

' Windows API calls to the registry are used so that the time zone
' information structures are properly filled.
#If VBA7 Then
  Private Declare PtrSafe Function RegOpenKeyEx _
                               Lib "advapi32.dll" _
                             Alias "RegOpenKeyExA" ( _
                                   ByVal hKey As LongPtr, _
                                   ByVal lpSubKey As String, _
                                   ByVal ulOptions As Long, _
                                   ByVal samDesired As Long, _
                                   phkResult As LongPtr) As Long

  Private Declare PtrSafe Function RegQueryValueEx _
                               Lib "advapi32.dll" _
                             Alias "RegQueryValueExA" ( _
                                   ByVal hKey As LongPtr, _
                                   ByVal lpszValueName As String, _
                                   ByVal lpdwReserved As LongPtr, _
                                   lpdwType As Long, _
                                   lpData As Any, _
                                   lpcbData As Long) As Long

  Private Declare PtrSafe Function RegCloseKey _
                               Lib "advapi32.dll" ( _
                                   ByVal hKey As LongPtr) As Long

  Private Declare PtrSafe Function TzSpecificLocalTimeToSystemTime _
                               Lib "kernel32" ( _
                                   lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
                                   lpLocalTime As SYSTEM_TIME, _
                                   lpUniversalTime As SYSTEM_TIME) As Integer
#Else
  Private Declare Function RegOpenKeyEx _
                       Lib "advapi32.dll" _
                     Alias "RegOpenKeyExA" ( _
                           ByVal hKey As Long, _
                           ByVal lpSubKey As String, _
                           ByVal ulOptions As Long, _
                           ByVal samDesired As Long, _
                           phkResult As Long) As Long

  Private Declare Function RegQueryValueEx _
                       Lib "advapi32.dll" _
                     Alias "RegQueryValueExA" ( _
                           ByVal hKey As Long, _
                           ByVal lpszValueName As String, _
                           ByVal lpdwReserved As Long, _
                           lpdwType As Long, _
                           lpData As Any, _
                           lpcbData As Long) As Long

  Private Declare Function RegCloseKey _
                       Lib "advapi32.dll" ( _
                           ByVal hKey As Long) As Long

  Private Declare Function TzSpecificLocalTimeToSystemTime _
                       Lib "kernel32" ( _
                           lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
                           lpLocalTime As SYSTEM_TIME, _
                           lpUniversalTime As SYSTEM_TIME) As Integer
#End If

' Registry key constant
Public Const strSubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"

' Returns the UTC date/time given a time zone, local date, and local time
Public Function fGetUTC(strTimeZone As String, _
                        dteDate As Date, _
                        tmeTime As Date) As Date

  Dim TZ          As TIME_ZONE_INFORMATION, _
      rTZI        As REG_TIME_ZONE_INFO, _
      LocalTZTime As SYSTEM_TIME, _
      UTCTime     As SYSTEM_TIME, _
      lngRetVal   As Long, _
      dteDateTime As Date

  #If VBA7 Then
    Dim hKeyResult As LongPtr
  #Else
    Dim hKeyResult As Long
  #End If

  ' Put the date and time together into something useful
  dteDateTime = DateSerial(Year(dteDate), Month(dteDate), Day(dteDate)) _
              + TimeSerial(Hour(tmeTime), Minute(tmeTime), Second(tmeTime))

  lngRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strSubKey & "\" & strTimeZone, 0, KEY_QUERY_VALUE, hKeyResult)

  ' Retrieve time zone information from the registry
  If lngRetVal = ERROR_SUCCESS Then
    lngRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, rTZI, Len(rTZI))

    ' Populate time zone structures
    If lngRetVal = ERROR_SUCCESS Then
      With TZ
        .Bias = rTZI.Bias
        .StandardBias = rTZI.StandardBias
        .DaylightBias = rTZI.DaylightBias
        .StandardDate = rTZI.StandardDate
        .DaylightDate = rTZI.DaylightDate

        lngRetVal = RegQueryValueEx(hKeyResult, "Std", 0&, REG_SZ, .StandardName(0), 32)
        lngRetVal = RegQueryValueEx(hKeyResult, "Dlt", 0&, REG_SZ, .DaylightName(0), 32)
      End With

      With LocalTZTime
        .wYear = Year(dteDateTime)
        .wMonth = Month(dteDateTime)
        .wDay = Day(dteDateTime)
        .wHour = Hour(dteDateTime)
        .wMinute = Minute(dteDateTime)
        .wSecond = Second(dteDateTime)
      End With

      ' Get UTC date/time taking DST into account
      If TzSpecificLocalTimeToSystemTime(TZ, LocalTZTime, UTCTime) <> 0 Then
        fGetUTC = fSystemTimeToVBTime(UTCTime)
      Else
        Err.Raise 1, "WINAPI", "Windows API call failed"
      End If

    End If

    RegCloseKey hKeyResult

  End If

End Function

' Convert API date/time to a VB date/time format
Private Function fSystemTimeToVBTime(SystemTime As SYSTEM_TIME) As Date

  With SystemTime
    fSystemTimeToVBTime = DateSerial(.wYear, .wMonth, .wDay) 
                        + TimeSerial(.wHour, .wMinute, .wSecond)
  End With

End Function

And now the easy part. You can execute the departure/arrival test with the following code. Make sure to check that your dates and times are valid before running it. You will also need to apply your own code to retrieve the departure and arrival time zones:

  Dim dteDepartUTC   As Date, _
      dteArriveUTC   As Date, _
      strElapsedTime As String, _
      lngMinutes     As Long

  ' Get UTC date/time for departure and arrival
  ' Substitute the parameters in square brackets with your own variable names
  dteDepartUTC = fGetUTC([Departure Time Zone], [Departure Date], [Departure Time])
  dteArriveUTC = fGetUTC([Arrival Time Zone], [Arrival Date], [Arrival Time])

  ' Calculate elapsed time if you find it useful. Use a string in case hours exceed 24.
  lngMinutes = DateDiff("n", dteDepartUTC, dteArriveUTC)
  strElapsedTime = Fix(lngMinutes / 60) & ":" & Format(Int(lngMinutes Mod 60), "00")

  If dteArriveUTC <= dteDepartUTC Then
    ... your error message here
  End If

Set Date/Time validation rule in Access 2019+

2 Answers2