VBA - Is Date DST

Public Function GetWeekdayOccurence(mnth As Integer, yr As Integer, dayofweek As Integer, occurence As Integer) As Date
'mnth: which month, 1=Jan
'yr: which year
'dayofweek: which day to find, 1 = sun
'occurence: which occurence of dayofweek to find in mnth
'To get second sunday of March, 2012 then GetWeekdayOccurence(3, 2012, 1, 2)
 
Dim i As Integer
 
For i = (occurence - 1) * 7 + 1 To occurence * 7 'Only need to check a 7 day period
    If Weekday(DateSerial(yr, 3, i)) = dayofweek Then
        GetWeekdayOccurence = DateSerial(yr, 3, i)
        Exit Function
    End If
Next i
End Function
 
Public Function IsDST(d As Date) As Boolean
 
If GetWeekdayOccurence(3, Year(d), 1, 2) > d And GetWeekdayOccurence(11, Year(d), 1, 1) < d Then
    IsDST = True
Else
    IsDST = False
End If
 
End Function

Select allOpen in new window

Public Function GetWeekdayOccurence(mnth As Integer, yr As Integer, dayofweek As Integer, occurence As Integer) As Date
'mnth: which month, 1=Jan
'yr: which year
'dayofweek: which day to find, 1 = sun
'occurence: which occurence of dayofweek to find in mnth
'To get second sunday of March, 2012 then GetWeekdayOccurence(3, 2012, 1, 2)
 
Dim i As Integer
 
For i = (occurence - 1) * 7 + 1 To occurence * 7
    If Weekday(DateSerial(yr, mnth, i)) = dayofweek Then
        GetWeekdayOccurence = DateSerial(yr, mnth, i)
        Exit Function
    End If
Next i
End Function
 
Public Function IsDST(d As Date) As Boolean
 
If d >= GetWeekdayOccurence(3, Year(d), 1, 2) And d <= GetWeekdayOccurence(11, Year(d), 1, 1) Then
    IsDST = True
Else
    IsDST = False
End If
 
End Function

Select allOpen in new window

Option Explicit
'Generated from two solutions by ZORVEK on WWW.Experts-Exchange.com
' GetSpecificLocalTimeFromGMT(Time Zone String, [DTG])
' IsDaylightSavingsDate(Date, [Time ZOne String])
Private Type tSystemTime
    Year As Integer
    Month As Integer
    DayOfWeek As Integer
    Day As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type 
Private Type tTimeZoneInformation
   Bias As Long
   StandardName(31) As Integer
   StandardDate As tSystemTime
   StandardBias As Long
   DaylightName(31) As Integer
   DaylightDate As tSystemTime
   DaylightBias As Long
   DynamicYear As Long
End Type 
Private Type tTimeZoneRecord
   TimeZoneName As String
   TimeZoneDisplayName As String
   FirstDynamicYear As Long
   LastDynamicYear As Long
   TimeZoneInformation() As tTimeZoneInformation
End Type 
Private Type tTZI
   Bias As Long
   StandardBias As Long
   DaylightBias As Long
   StandardDate As tSystemTime
   DaylightDate As tSystemTime
End Type 
Private mTimeZoneRecordCount As Long
Private mTimeZoneRecords() As tTimeZoneRecord 
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" ( _
      pTo As Any, _
      uFrom As Any, _
      ByVal lSize As Long _
   )
Private Declare Function GetTimeZoneInformation Lib "Kernel32" ( _
      lpTimeZoneInformation As tTimeZoneInformation _
   ) As Long 
Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32.dll" ( _
      ByRef lpTimeZoneInformation As tTimeZoneInformation, _
      ByRef lpUniversalTime As tSystemTime, _
      ByRef lpLocalTime As tSystemTime _
   ) As Long 
Private Function GetByteArrayFromVariantByteArray( _
      ByRef ByteArray As Variant _
   ) As Byte() 
   Dim index As Long
   Dim Result() As Byte
   
   ReDim Result(LBound(ByteArray) To UBound(ByteArray))
   For index = LBound(ByteArray) To UBound(ByteArray)
      Result(index) = ByteArray(index)
   Next index
   GetByteArrayFromVariantByteArray = Result 
End Function 
Private Function GetLastWeekdayOfMonth( _
      ByVal YearParam As Long, _
      ByVal MonthParam As Long, _
      ByVal DayOfWeek As Long _
   ) As Date 
' Return the last day of week of the month. YearParam and MonthParam are the
' year and month. DayOfWeek is the day of the week where 1=Sunday and
' 7=Saturday.
'
' Syntax
'
' GetLastWeekdayOfMonth(YearParam, MonthParam, DayOfWeek)
'
' YearParam - The year.
'
' MonthParam - The month.
'
' DayOfWeek - The day of the week where 1=Sunday and 7=Saturday. 
   Dim FirstDateOfNextMonth As Date 
   FirstDateOfNextMonth = DateSerial(YearParam, MonthParam + 1, 1)
   GetLastWeekdayOfMonth = FirstDateOfNextMonth + DayOfWeek - Weekday(FirstDateOfNextMonth) - (1 + (DayOfWeek < Weekday(FirstDateOfNextMonth))) * 7 
End Function 
Private Function GetNthWeekdayOfMonth( _
      ByVal YearParam As Long, _
      ByVal MonthParam As Long, _
      ByVal DayOfWeek As Long, _
      ByVal Occurrence As Long _
   ) As Date 
' Returns the nth day of week of the month.
'
' Syntax
'
' GetNthWeekdayOfMonth(YearParam, MonthParam, DayOfWeek, Occurrence)
'
' YearParam - The year.
'
' MonthParam - The month.
'
' DayOfWeek - The day of the week where 1=Sunday and 7=Saturday.
'
' Occurrence - The desired weekday occurrence (1=first, 2 = second, etc.) 
   Dim FirstDateOfMonth As Date 
   FirstDateOfMonth = DateSerial(YearParam, MonthParam, 1)
   GetNthWeekdayOfMonth = FirstDateOfMonth + DayOfWeek - Weekday(FirstDateOfMonth) + (Occurrence - (DayOfWeek >= Weekday(FirstDateOfMonth))) * 7 
End Function 
Private Function GetTimeZoneInformationForTimeZone( _
      ByVal TimeZoneDescription As String, _
      Optional ByVal DynamicYear As Long _
   ) As tTimeZoneInformation 
' Return the requested time zone information record.
'
' Syntax
'
' GetTimeZoneInformationForTimeZone(TimeZoneDescription)
'
' TimeZoneDescription - A time zone display name (as appears in the Date and
'   Time control panel), or the registry key name. The difference between the
'   two is the display description includes the GMT bias text and usually
'   lists one or more cities while the registry description is close to the
'   time zone name. Both lists are obtainable using the GetTimeZoneDescriptions
'   function. 
   Dim TZIndex As Long
   Dim DynamicYearIndex As Long
   Dim Result As Long
   Dim TimeZoneInformation As tTimeZoneInformation
   Dim index As Long
   
   InitializeTimeZoneRecords
   
   If Len(TimeZoneDescription) = 0 Then
      Result = GetTimeZoneInformation(TimeZoneInformation)
      For index = 0 To 31
         TimeZoneDescription = TimeZoneDescription & CHR(TimeZoneInformation.StandardName(index))
      Next index
      TimeZoneDescription = left(TimeZoneDescription, InStr(TimeZoneDescription, CHR(0)) - 1)
   End If
   
   If DynamicYear = 0 Then DynamicYear = Year(Now())
   
   For TZIndex = 1 To mTimeZoneRecordCount
      If TimeZoneDescription = mTimeZoneRecords(TZIndex).TimeZoneName Or TimeZoneDescription = mTimeZoneRecords(TZIndex).TimeZoneDisplayName Then
         If mTimeZoneRecords(TZIndex).FirstDynamicYear = 0 Then
            GetTimeZoneInformationForTimeZone = mTimeZoneRecords(TZIndex).TimeZoneInformation(1)
            Exit Function
         Else
            For DynamicYearIndex = 1 To UBound(mTimeZoneRecords(TZIndex).TimeZoneInformation)
               If DynamicYear = mTimeZoneRecords(TZIndex).TimeZoneInformation(DynamicYearIndex).DynamicYear _
                     Or _
                  DynamicYear < mTimeZoneRecords(TZIndex).FirstDynamicYear And mTimeZoneRecords(TZIndex).TimeZoneInformation(DynamicYearIndex).DynamicYear = mTimeZoneRecords(TZIndex).FirstDynamicYear _
                     Or _
                  DynamicYear > mTimeZoneRecords(TZIndex).LastDynamicYear And mTimeZoneRecords(TZIndex).TimeZoneInformation(DynamicYearIndex).DynamicYear = mTimeZoneRecords(TZIndex).LastDynamicYear _
               Then
                  GetTimeZoneInformationForTimeZone = mTimeZoneRecords(TZIndex).TimeZoneInformation(DynamicYearIndex)
                  Exit Function
               End If
            Next DynamicYearIndex
         End If
      End If
   Next TZIndex
   
End Function 
Private Sub InitializeTimeZoneRecords() 
' Initialize the time zone record array.
'
' Syntax
'
' InitializeTimeZoneRecords() 
   Dim ScriptObject As Object
   Dim Registry As Object
   Dim TZKeyList As Variant
   Dim TZKeyName As Variant
   Dim DynamicDSTTZKeyList As Variant
   Dim DynamicDSTTZKeyName As Variant
   Dim Value As Variant
   Dim ByteArray() As Byte
   Dim TZI As tTZI
   Dim TimeZoneDisplayName As String
   Dim DynamicDSTTZCount As Long
   Dim StandardName(31) As Integer
   Dim DaylightName(31) As Integer
   
   Const HKEY_LOCAL_MACHINE = &H80000002
   Const TimeZonesPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
   
   If mTimeZoneRecordCount > 0 Then Exit Sub 
   Set ScriptObject = CreateObject("WScript.Shell")
   Set Registry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
   Registry.EnumKey HKEY_LOCAL_MACHINE, TimeZonesPath, TZKeyList
   mTimeZoneRecordCount = 1
   ReDim mTimeZoneRecords(1 To UBound(TZKeyList) + 1)
   For Each TZKeyName In TZKeyList
      With mTimeZoneRecords(mTimeZoneRecordCount)
         .TimeZoneName = TZKeyName
         Registry.GetStringValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName, "Display", TimeZoneDisplayName
         .TimeZoneDisplayName = TimeZoneDisplayName
         Registry.GetStringValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName, "Dlt", Value
         ByteArray = Value
         CopyMemory DaylightName(0), ByteArray(0), Len(Value) * 2
         Registry.GetStringValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName, "Std", Value
         ByteArray = Value
         CopyMemory StandardName(0), ByteArray(0), Len(Value) * 2
         Registry.EnumValues HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName & "\Dynamic DST", DynamicDSTTZKeyList
         If IsNull(DynamicDSTTZKeyList) Then
            ReDim .TimeZoneInformation(1 To 1)
            Registry.GetBinaryValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName, "TZI", Value
            ByteArray = GetByteArrayFromVariantByteArray(Value)
            CopyMemory TZI, ByteArray(0), Len(TZI)
            .TimeZoneInformation(1).Bias = TZI.Bias
            .TimeZoneInformation(1).DaylightBias = TZI.DaylightBias
            .TimeZoneInformation(1).DaylightDate = TZI.DaylightDate
            .TimeZoneInformation(1).StandardBias = TZI.StandardBias
            .TimeZoneInformation(1).StandardDate = TZI.StandardDate
            CopyMemory .TimeZoneInformation(1).DaylightName(0), DaylightName(0), UBound(DaylightName) * 2
            CopyMemory .TimeZoneInformation(1).StandardName(0), StandardName(0), UBound(StandardName) * 2
         Else
            ReDim .TimeZoneInformation(1 To UBound(DynamicDSTTZKeyList) - 1)
            DynamicDSTTZCount = 1
            Registry.GetDWordValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName & "\Dynamic DST", "FirstEntry", Value
            .FirstDynamicYear = Value
            Registry.GetDWordValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName & "\Dynamic DST", "LastEntry", Value
            .LastDynamicYear = Value
            For Each DynamicDSTTZKeyName In DynamicDSTTZKeyList
               If IsNumeric(DynamicDSTTZKeyName) Then
                  With .TimeZoneInformation(DynamicDSTTZCount)
                     Registry.GetBinaryValue HKEY_LOCAL_MACHINE, TimeZonesPath & "\" & TZKeyName & "\Dynamic DST", DynamicDSTTZKeyName, Value
                     ByteArray = GetByteArrayFromVariantByteArray(Value)
                     CopyMemory TZI, ByteArray(0), Len(TZI)
                     .Bias = TZI.Bias
                     .DaylightBias = TZI.DaylightBias
                     .DaylightDate = TZI.DaylightDate
                     .StandardBias = TZI.StandardBias
                     .StandardDate = TZI.StandardDate
                     CopyMemory .DaylightName(0), DaylightName(0), UBound(DaylightName) * 2
                     CopyMemory .StandardName(0), StandardName(0), UBound(StandardName) * 2
                     .DynamicYear = DynamicDSTTZKeyName
                  End With
                  DynamicDSTTZCount = DynamicDSTTZCount + 1
               End If
            Next
         End If
         mTimeZoneRecordCount = mTimeZoneRecordCount + 1
      End With
   Next TZKeyName
   mTimeZoneRecordCount = mTimeZoneRecordCount - 1 
End Sub 
Private Function GetGMTTimeFromLocalTime( _
      Optional ByVal DateTime As Date _
   ) As Date 
' Return GMT given a local date and time.
'
' Syntax
'
' GetGMTTimeFromLocalTime(DateTime)
'
' DateTime - The local date and time. Optional. If omitted then the current
'   local date and time are used.
   
   Dim Difference As Long
   
   Difference = GetTimeDifference()
   
   If DateTime = 0 Then
      GetGMTTimeFromLocalTime = DateAdd("s", -Difference, Now)
   Else
      GetGMTTimeFromLocalTime = DateAdd("s", -Difference, DateTime)
   End If
   
End Function 
Private Function GetTimeDifference( _
      Optional ByVal DateTime As Date _
   ) As Long 
' Return the time difference between the current time zone and GMT in seconds.
'
' Syntax
'
' GetTimeDifference(DateTime)
'
' DateTime - The date time for which the difference is to be calculated. The
'   difference is only impacted if the date time passed has a different
'   daylight savings setting than the current date time. Optional. If omitted
'   then the current date time is used.
    
   Dim TimeZoneInformation As tTimeZoneInformation
   
   If DateTime = 0 Then DateTime = Now
   
   GetTimeZoneInformation TimeZoneInformation
   GetTimeDifference = -TimeZoneInformation.Bias * 60
   ' Handle daylight savings
   If IsDaylightSavingsDate(DateTime) Then GetTimeDifference = GetTimeDifference - TimeZoneInformation.DaylightBias * 60 
End Function 
Public Function IsDaylightSavingsDate( _
      ByVal DateTime As Date, _
      Optional ByVal TimeZoneDescription As String _
   ) As Boolean 
' Return True if daylight savings is in effect at the date time specified,
' False otherwise.
'
' Syntax
'
' IsDaylightSavingsDate(DateTime)
'
' DateTime - The date time value for which to determine if daylight savings is
'   in effect.
'
' TimeZoneDescription - The "standard" name of the time zone. Optional. If
'   omitted then the local time zone is used.
   
   Dim TimeZoneInformation As tTimeZoneInformation
   Dim DaylightDate As Date
   Dim StandardDate As Date
   
   TimeZoneInformation = GetTimeZoneInformationForTimeZone(TimeZoneDescription, Year(DateTime))
   
   If TimeZoneInformation.DaylightDate.Month <> 0 Then
      If TimeZoneInformation.DaylightDate.Day < 5 Then
         DaylightDate = GetNthWeekdayOfMonth(Year(DateTime), TimeZoneInformation.DaylightDate.Month, TimeZoneInformation.DaylightDate.DayOfWeek + 1, TimeZoneInformation.DaylightDate.Day)
      Else
         DaylightDate = GetLastWeekdayOfMonth(Year(DateTime), TimeZoneInformation.DaylightDate.Month, TimeZoneInformation.DaylightDate.DayOfWeek + 1)
      End If
      DaylightDate = DaylightDate + TimeSerial(TimeZoneInformation.DaylightDate.Hour, 0, 0)
      If TimeZoneInformation.StandardDate.Day < 5 Then
         StandardDate = GetNthWeekdayOfMonth(Year(DateTime), TimeZoneInformation.StandardDate.Month, TimeZoneInformation.StandardDate.DayOfWeek + 1, TimeZoneInformation.StandardDate.Day)
      Else
         StandardDate = GetLastWeekdayOfMonth(Year(DateTime), TimeZoneInformation.StandardDate.Month, TimeZoneInformation.StandardDate.DayOfWeek + 1)
      End If
      StandardDate = StandardDate + TimeSerial(TimeZoneInformation.StandardDate.Hour, 0, 0)
      If DaylightDate < StandardDate Then
         If DateTime >= DaylightDate And DateTime < StandardDate Then IsDaylightSavingsDate = True
      Else
         If DateTime < StandardDate Or DateTime >= DaylightDate Then IsDaylightSavingsDate = True
      End If
   End If
   
End Function 
Public Function GetSpecificLocalTimeFromGMT( _
      ByVal TimeZoneDescription As String, _
      Optional ByVal GMTDateTime As Date _
   ) As Date 
' Return the specified local time given the GMT.
'
' Syntax
'
' GetSpecificLocalTimeFromGMT(TimeZoneInformation, GMTDateTime)
'
' TimeZoneInformation - A time zone information record obtained using
'   GetTimeZoneInformationForTimeZone.
'
' GMTDateTime - GMT as a VB date value. Optional. If omitted then the current
'   GMT time is used. 
   Dim TimeZoneInformation As tTimeZoneInformation
   Dim LocalSystemTime As tSystemTime
   Dim GMTSystemTime As tSystemTime
   
   TimeZoneInformation = GetTimeZoneInformationForTimeZone(TimeZoneDescription)
   If TimeZoneInformation.DaylightName(0) = 0 Then Exit Function 
   If GMTDateTime = 0 Then GMTDateTime = GetGMTTimeFromLocalTime
   
   GMTSystemTime = GetSystemTimeFromDateTime(GMTDateTime)
   
   SystemTimeToTzSpecificLocalTime TimeZoneInformation, GMTSystemTime, LocalSystemTime
   GetSpecificLocalTimeFromGMT = GetDateTimeFromSystemTime(LocalSystemTime)
    
End Function 
Private Function GetDateTimeFromSystemTime( _
      ByRef SystemTime As tSystemTime _
   ) As Date
   
' Return the system time record as a date time.
'
' Syntax
'
' GetDateTimeFromSystemTime(SystemTime)
'
' SystemTime - A system time record.
   
   With SystemTime
      GetDateTimeFromSystemTime = DateSerial(.Year, .Month, .Day) + TimeSerial(.Hour, .Minute, .Second)
   End With
   
End Function 
Private Function GetSystemTimeFromDateTime( _
      ByVal DateTime As Date _
   ) As tSystemTime
   
' Return the system time record given a date time value.
'
' Syntax
'
' GetSystemTimeFromDateTime(DateTime)
'
' DateTime - A date time value. 
   GetSystemTimeFromDateTime.Year = Year(DateTime)
   GetSystemTimeFromDateTime.Month = Month(DateTime)
   GetSystemTimeFromDateTime.Day = Day(DateTime)
   GetSystemTimeFromDateTime.Hour = Hour(DateTime)
   GetSystemTimeFromDateTime.Minute = Minute(DateTime)
   GetSystemTimeFromDateTime.Second = Second(DateTime) 
End Function 
'The standard time zone names are: 
'Afghanistan Standard Time
'Alaskan Standard Time
'Arab Standard Time
'Arabian Standard Time
'Arabic Standard Time
'Armenian Standard Time
'Atlantic Standard Time
'AUS Central Standard Time
'AUS Eastern Standard Time
'Azerbaijan Standard Time
'Azores Standard Time
'Canada Central Standard Time
'Cape Verde Standard Time
'Caucasus Standard Time
'Cen. Australia Standard Time
'Central America Standard Time
'Central Asia Standard Time
'Central Brazilian Standard Time
'Central Europe Standard Time
'Central European Standard Time
'Central Pacific Standard Time
'Central Standard Time
'Central Standard Time (Mexico)
'China Standard Time
'Dateline Standard Time
'E. Africa Standard Time
'E. Australia Standard Time
'E. Europe Standard Time
'E. South America Standard Time
'Eastern Standard Time
'Egypt Standard Time
'Ekaterinburg Standard Time
'Fiji Standard Time
'FLE Standard Time
'Georgian Standard Time
'GMT Standard Time
'Greenland Standard Time
'Greenwich Standard Time
'GTB Standard Time
'Hawaiian Standard Time
'India Standard Time
'Iran Standard Time
'Israel Standard Time
'Jordan Standard Time
'Korea Standard Time
'Mexico Standard Time
'Mexico Standard Time 2
'Mid-Atlantic Standard Time
'Middle East Standard Time
'Montevideo Standard Time
'Mountain Standard Time
'Mountain Standard Time (Mexico)
'Myanmar Standard Time
'N. Central Asia Standard Time
'Namibia Standard Time
'Nepal Standard Time
'New Zealand Standard Time
'Newfoundland Standard Time
'North Asia East Standard Time
'North Asia Standard Time
'Pacific SA Standard Time
'Pacific Standard Time
'Pacific Standard Time (Mexico)
'Romance Standard Time
'Russian Standard Time
'SA Eastern Standard Time
'SA Pacific Standard Time
'SA Western Standard Time
'Samoa Standard Time
'SE Asia Standard Time
'Singapore Standard Time
'South Africa Standard Time
'Sri Lanka Standard Time
'Taipei Standard Time
'Tasmania Standard Time
'Tokyo Standard Time
'Tonga Standard Time
'US Eastern Standard Time
'US Mountain Standard Time
'Venezuela Standard Time
'Vladivostok Standard Time
'W. Australia Standard Time
'W. Central Africa Standard Time
'W. Europe Standard Time
'West Asia Standard Time
'West Pacific Standard Time
'Yakutsk Standard Time

Select allOpen in new window