Difference in hours between two dates on daylight saving time with VBA

208 Views Asked by At

Last Sunday had 23 hours due to the daylight saving time change. As a result some of my daily calculations are incorrect because they are made with an assumption of 24 hours.

I cannot find the method to calculate those 23 hours (25 in the case of the winter time change).

2

There are 2 best solutions below

0
Gustav On

You can use the timezone function BiasWindowsTimezone in my project at GitHub:

VBA.Timezone-Windows

(module WtziCore) to obtain the bias values for the start and the end time taking DST in account. Then, add the bias values to both date values and calculate the difference in hours:

Public Function HoursNormal( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    ByVal Timezone As String) _
    As Long

    Dim Date1Normal As Date
    Dim Date2Normal As Date
    Dim Hours       As Long
    
    Date1Normal = DateAdd("n", BiasWindowsTimezone(Timezone, True, Date1), Date1)
    Date2Normal = DateAdd("n", BiasWindowsTimezone(Timezone, True, Date2), Date2)
    
    Hours = DateDiff("h", Date1Normal, Date2Normal)
    
    HoursNormal = Hours

End Function

The timezone must be the literal of yours as found in the Windows Registry, for example W. Europe (there is code as well to retrieve and list these), and using your Sunday date, you will get 23 hours:

Date1 = #2022-03-27 00:00#
Date2 = #2022-03-28 00:00#

? HoursNormal(Date1, Date2, "W. Europe")
 23 
1
Emilio Sancha On

This returns 23h for March 27th and 25h for Oct 30th dates of the time change.

Function HorasDia(datFecha As Date) As Byte
Dim OutlookApp As Object
On Error Resume Next

Set OutlookApp = CreateObject("Outlook.Application")
HorasDia = DateDiff("h", OutlookApp.TimeZones.ConvertTime(datFecha, OutlookApp.TimeZones.Item("W. Europe Standard Time"), OutlookApp.TimeZones.Item("UTC")), OutlookApp.TimeZones.ConvertTime(datFecha + 1, OutlookApp.TimeZones.Item("W. Europe Standard Time"), OutlookApp.TimeZones.Item("UTC")))

If Not OutlookApp Is Nothing Then Set OutlookApp = Nothing
End Function