Attribute VB_Name = "ex_Time"
' ======== Time conversion ========
' Shared module version: 20210630
' Tested in:
' Depends on:
' Required reference:
Option Private Module
Option Explicit

''
' VBA-UTC v1.0.6
' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter
' UTC/ISO 8601 Converter for VBA
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '

Private Declare PtrSafe Function UTC_GetTimeZoneInfo Lib "kernel32" Alias "GetTimeZoneInformation" _
    (utc_lpTimeZoneInformation As TTimeZone) As Long
Private Declare PtrSafe Function UTC_SystemTimeToLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
    (utc_lpTimeZoneInformation As TTimeZone, utc_lpUniversalTime As TSystemTime, utc_lpLocalTime As TSystemTime) As Long
Private Declare PtrSafe Function UTC_LocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
    (utc_lpTimeZoneInformation As TTimeZone, utc_lpLocalTime As TSystemTime, utc_lpUniversalTime As TSystemTime) As Long

Private Type TSystemTime
  utc_wYear As Integer
  utc_wMonth As Integer
  utc_wDayOfWeek As Integer
  utc_wDay As Integer
  utc_wHour As Integer
  utc_wMinute As Integer
  utc_wSecond As Integer
  utc_wMilliseconds As Integer
End Type

Private Type TTimeZone
  utc_Bias As Long
  utc_StandardName(0 To 31) As Integer
  utc_StandardDate As TSystemTime
  utc_StandardBias As Long
  utc_DaylightName(0 To 31) As Integer
  utc_DaylightDate As TSystemTime
  utc_DaylightBias As Long
End Type

Private Const ERR_UTC_PARSE_FAIL = vbObjectError + 1025
Private Const ERR_UTC_CONVERSION_FAIL = vbObjectError + 1026
Private Const ERR_ISO_PARSE_FAIL = vbObjectError + 1027
Private Const ERR_ISO_CONVERSION_FAIL = vbObjectError + 1028

' Parse UTC date to local date
Public Function ParseUtc(utc_UtcDate As Date) As Date
  On Error GoTo ON_ERROR

  Dim utc_TimeZoneInfo As TTimeZone
  Dim utc_LocalDate As TSystemTime

  Call UTC_GetTimeZoneInfo(utc_TimeZoneInfo)
  Call UTC_SystemTimeToLocalTime(utc_TimeZoneInfo, UTC_DateToSystemTime(utc_UtcDate), utc_LocalDate)

  ParseUtc = UTC_SystemTimeToDate(utc_LocalDate)
  Exit Function

ON_ERROR:
  Call Err.Raise(ERR_UTC_PARSE_FAIL, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description)
End Function

' Convert local date to UTC date
Public Function ConvertToUtc(utc_LocalDate As Date) As Date
  On Error GoTo ON_ERROR

  Dim utc_TimeZoneInfo As TTimeZone
  Dim utc_UtcDate As TSystemTime

  UTC_GetTimeZoneInfo utc_TimeZoneInfo
  UTC_LocalTimeToSystemTime utc_TimeZoneInfo, UTC_DateToSystemTime(utc_LocalDate), utc_UtcDate

  ConvertToUtc = UTC_SystemTimeToDate(utc_UtcDate)
  Exit Function

ON_ERROR:
  Call Err.Raise(ERR_UTC_PARSE_FAIL, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description)
End Function

' Parse ISO 8601 date string to local date
Public Function ParseIso(sISOTime$) As Date
  On Error GoTo ON_ERROR

  Dim utc_Parts() As String
  Dim utc_DateParts() As String
  Dim utc_TimeParts() As String
  Dim utc_OffsetIndex&
  Dim utc_HasOffset As Boolean
  Dim utc_NegativeOffset As Boolean
  Dim utc_OffsetParts() As String
  Dim utc_Offset As Date

  utc_Parts = VBA.Split(sISOTime, "T")
  utc_DateParts = VBA.Split(utc_Parts(0), "-")
  ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2)))

  If UBound(utc_Parts) > 0 Then
    If VBA.InStr(utc_Parts(1), "Z") Then
      utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":")
    Else
      utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+")
      If utc_OffsetIndex = 0 Then
        utc_NegativeOffset = True
        utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-")
      End If

      If utc_OffsetIndex > 0 Then
        utc_HasOffset = True
        utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":")
        utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":")

        Select Case UBound(utc_OffsetParts)
        Case 0
          utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0)
        Case 1
          utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0)
        Case 2
          ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
          utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2))))
        End Select

        If utc_NegativeOffset Then: utc_Offset = -utc_Offset
      Else
        utc_TimeParts = VBA.Split(utc_Parts(1), ":")
      End If
    End If

    Select Case UBound(utc_TimeParts)
    Case 0
      ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0)
    Case 1
      ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0)
    Case 2
      ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
      ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2))))
    End Select

    ParseIso = ParseUtc(ParseIso)

    If utc_HasOffset Then
      ParseIso = ParseIso - utc_Offset
    End If
  End If

  Exit Function

ON_ERROR:
  Err.Raise ERR_ISO_PARSE_FAIL, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & sISOTime & ": " & Err.Number & " - " & Err.Description
End Function

' Convert local date to ISO 8601 string
Public Function ConvertToIso(utc_LocalDate As Date) As String
  On Error GoTo ON_ERROR
  ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z")
  Exit Function

ON_ERROR:
  Call Err.Raise(ERR_ISO_CONVERSION_FAIL, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description)
End Function

' =============================================
Private Function UTC_DateToSystemTime(utc_Value As Date) As TSystemTime
  UTC_DateToSystemTime.utc_wYear = VBA.Year(utc_Value)
  UTC_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value)
  UTC_DateToSystemTime.utc_wDay = VBA.Day(utc_Value)
  UTC_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value)
  UTC_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value)
  UTC_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value)
  UTC_DateToSystemTime.utc_wMilliseconds = 0
End Function

Private Function UTC_SystemTimeToDate(utc_Value As TSystemTime) As Date
  UTC_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _
    TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)
End Function