Option Explicit
Function ConvertToGMT(LocalTime As Date, GMT_Adjust As Double, Optional Observes As Boolean = True, _
Optional Country As String = "US")
Dim StartDST As Date
Dim EndDST As Date
If Observes = False Then
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
Exit Function
End If
Select Case Country
Case "US", "USA", "United States"
If Year(LocalTime) < 2007 Then
StartDST = DateAdd("h", 2, NthWeekday(1, 1, 4, Year(LocalTime)))
EndDST = DateAdd("h", 2, NthWeekday("L", 1, 10, Year(LocalTime)))
Else
StartDST = DateAdd("h", 2, NthWeekday(2, 1, 3, Year(LocalTime)))
EndDST = DateAdd("h", 2, NthWeekday(1, 1, 11, Year(LocalTime)))
End If
If LocalTime >= StartDST And LocalTime <= EndDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "CA", "Canada", "MX", "Mexico"
StartDST = DateAdd("h", 2, NthWeekday(1, 1, 4, Year(LocalTime)))
EndDST = DateAdd("h", 2, NthWeekday("L", 1, 10, Year(LocalTime)))
If LocalTime >= StartDST And LocalTime <= EndDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "EU", "European Union", "AT", "Austria", "BE", "Belgium", "CY", "Cyprus", "CZ", "Czech Republic", _
"DK", "Denmark", "EE", "Estonia", "FI", "Finland", "FR", "France", "DE", "Germany", "GR", "Greece", _
"HU", "Hungary", "IE", "Ireland", "IT", "Italy", "LV", "Latvia", "LT", "Lithuania", _
"LU", "Luxembourg", "MT", "Malta", "NL", "The Netherlands", "Netherlands", "Holland", "PL", "Poland", _
"PT", "Portugal", "SK", "Slovakia", "SI", "Slovenia", "ES", "Spain", "SE", "Sweden", _
"GB", "UK", "United Kingdom", "England"
StartDST = DateAdd("h", 1 + GMT_Adjust, NthWeekday("L", 1, 3, Year(LocalTime)))
EndDST = DateAdd("h", 1 + GMT_Adjust, NthWeekday("L", 1, 10, Year(LocalTime)))
If LocalTime >= StartDST And LocalTime <= EndDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "RU", "Russia", "Russian Federation"
StartDST = DateAdd("h", 2, NthWeekday("L", 1, 3, Year(LocalTime)))
EndDST = DateAdd("h", 2, NthWeekday("L", 1, 10, Year(LocalTime)))
If LocalTime >= StartDST And LocalTime <= EndDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "AU", "Australia"
EndDST = DateAdd("h", 2, NthWeekday("L", 1, 3, Year(LocalTime)))
StartDST = DateAdd("h", 2, NthWeekday("L", 1, 10, Year(LocalTime)))
If LocalTime <= EndDST Or LocalTime >= StartDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "Tasmania"
EndDST = DateAdd("h", 2, NthWeekday("L", 1, 3, Year(LocalTime)))
StartDST = DateAdd("h", 2, NthWeekday(1, 1, 10, Year(LocalTime)))
If LocalTime <= EndDST Or LocalTime >= StartDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "NZ", "New Zealand"
EndDST = DateAdd("h", 2, NthWeekday(3, 1, 3, Year(LocalTime)))
StartDST = DateAdd("h", 2, NthWeekday(1, 1, 10, Year(LocalTime)))
If LocalTime <= EndDST Or LocalTime >= StartDST Then
ConvertToGMT = DateAdd("n", -(GMT_Adjust + 1) * 60, LocalTime)
Else
ConvertToGMT = DateAdd("n", -GMT_Adjust * 60, LocalTime)
End If
Case "ZA", "South Africa"
ConvertToGMT = DateAdd("n", GMT_Adjust * 60, LocalTime)
Case "CN", "China", "IN", "India", "JP", "Japan", "TW", "Taiwan", "Taipei"
ConvertToGMT = DateAdd("n", GMT_Adjust * 60, LocalTime)
Case Else
ConvertToGMT = DateAdd("n", GMT_Adjust * 60, LocalTime)
End Select
End Function
Public Function NthWeekday(Position, DayIndex As Long, TargetMonth As Long, Optional TargetYear As Long)
Dim FirstDate As Date
If DayIndex < 1 Or DayIndex > 7 Then
NthWeekday = CVErr(xlErrValue)
Exit Function
End If
If TargetYear = 0 Then TargetYear = Year(Now)
Select Case Position
Case 1, 2, 3, 4, 5, "L", "l"
FirstDate = DateSerial(TargetYear, TargetMonth, 1)
If Weekday(FirstDate, vbSunday) < DayIndex Then
FirstDate = FirstDate + (DayIndex - Weekday(FirstDate, vbSunday))
ElseIf Weekday(FirstDate, vbSunday) > DayIndex Then
FirstDate = FirstDate + (DayIndex + 7 - Weekday(FirstDate, vbSunday))
End If
If IsNumeric(Position) Then
NthWeekday = FirstDate + (Position - 1) * 7
If Month(NthWeekday) <> Month(FirstDate) Then NthWeekday = CVErr(xlErrValue)
Else
NthWeekday = FirstDate
Do Until Month(NthWeekday) <> Month(NthWeekday + 7)
NthWeekday = NthWeekday + 7
Loop
End If
Case Else
NthWeekday = CVErr(xlErrValue)
End Select
End Function
|