Get Timezone Information in VBA (Excel)

Question

I would like to determine a time offset to GMT/UTC (including daylight saving time) for different countries at a specific date in VBA. Any ideas?

EDIT (from self-an

Answer 1

A few tweaks to Patrick Honorez's great solution.

A bit of error checking and some extra tests. :-)

Option Explicit

'mTimeZones by Patrick Honorez --- www.idevlop.com
'with the precious help of Julian Hess https://stackoverflow.com/a/45510712/78522
'You can reuse but please let all the original comments including this one.

'This modules uses late binding and therefore should not require an explicit reference to Outlook,
'however Outlook must be properly installed and configured on the machine using this module
'Module works with Excel and Access

'Murray Hopkins: a few tweaks for better useability

Private oOutl As Object 'keep Outlook reference active, to save time n recurring calls

Private Function GetOutlook() As Boolean
'get or start an Outlook instance and assign it to oOutl
'returns True if successful, False otherwise
    If oOutl Is Nothing Then
        'Debug.Print "~"
        On Error Resume Next
        Err.Clear
        Set oOutl = GetObject(, "Outlook.Application")
        If Err.Number Then
            Err.Clear
            Set oOutl = CreateObject("Outlook.Application")
        End If
    End If
    GetOutlook = Not (oOutl Is Nothing)
    On Error GoTo 0
End Function

Public Function ConvertTime(DT As Date, Optional TZfrom As String = "UTC", Optional TZto As String = "") As Date
'convert datetime with hour from Source time zone to Target time zone
'valid Source & Target time zones can be found in your registry under: HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/
'this version using Outlook, properly handles Dailight Saving Times, including for past and future dates
'it includes a fix for the fact that ConvertTime seems to strip the seconds
'krammy85 2019-01-25 Edit: Outlook rounds minutes when it strips seconds, so modified code to strip seconds (without rounding) prior to running Outlook's ConvertTime.
    Dim TZones As Object
    Dim sourceTZ As Object
    Dim destTZ As Object
    Dim seconds As Single
    Dim DT_SecondsStripped As Date

            ' If the conversion fails it will return the time unchanged
            ' You could change this if you want
    Dim convertedTime As Date
    convertedTime = DT

    If GetOutlook Then
        'fix for ConvertTime stripping the seconds
        seconds = Second(DT) / 86400    'save the seconds as DateTime (86400 = 24*60*60)
        DT_SecondsStripped = DT - seconds
        Set TZones = oOutl.TimeZones

        Set sourceTZ = TZones.item(TZfrom)

        ' Default to the timezone currently on this system if not passed in
        If TZto = "" Then TZto = oOutl.TimeZones.CurrentTimeZone

        Set destTZ = TZones.item(TZto)

        If validTimeZoneName(TZfrom, sourceTZ) And validTimeZoneName(TZto, destTZ) Then
            convertedTime = TZones.ConvertTime(DT_SecondsStripped, sourceTZ, destTZ) + seconds    'add the stripped seconds
        End If
    Else
        Call MsgBox("Could not find MS-Outlook on this computer." & vbCrLf & "It mut be installed for this app to work", vbCritical, "ERROR")
        End
    End If

    ConvertTime = convertedTime
End Function

' Make sure the time zone name returned an entry from the Registry
Private Function validTimeZoneName(tzName, TZ) As Boolean
    Dim nameIsValid As Boolean

    nameIsValid = True

    If TZ Is Nothing Then
        Call MsgBox("The timezone name of '" & tzName & "' is not valid." & vbCrLf & "Please correct it and try again.", vbCritical, "ERROR")

        ' This might be too harsh. ie ends the app.
        ' End
        nameIsValid = False
    End If

    validTimeZoneName = nameIsValid
End Function

' Tests
Public Sub test_ConvertTime()
    Dim t As Date, TZ As String

    t = #8/23/2019 6:15:05 AM#
    Debug.Print "System default", t, ConvertTime(t), Format(t - ConvertTime(t), "h:nn")

    Call test_DoConvertTime("UTC", "AUS Eastern Standard Time")
    Call test_DoConvertTime("UTC", "AUS Central Standard Time")
    Call test_DoConvertTime("UTC", "E. Australia Standard Time")
    Call test_DoConvertTime("UTC", "Aus Central W. Standard Time")
    Call test_DoConvertTime("UTC", "W. Australia Standard Time")
    Call test_DoConvertTime("W. Australia Standard Time", "AUS Eastern Standard Time")

        ' Throw error
    Call test_DoConvertTime("UTC", "Mars Polar Time")

    End
End Sub

Public Sub test_DoConvertTime(ByVal fromTZ As String, ByVal toTZ As String)
    Dim t As Date, TZ As String, resDate As Date, msg

    t = #8/23/2019 6:15:05 AM#
    resDate = ConvertTime(t, fromTZ, toTZ)
    msg = fromTZ & " to " & toTZ
    Debug.Print msg, t, resDate, Format(t - resDate, "h:nn")

End Sub