Get Timezone Information in VBA (Excel)

前端 未结 7 965
春和景丽
春和景丽 2020-11-29 09:27

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

相关标签:
7条回答
  • 2020-11-29 09:44

    I recommend to create an Outlook object and use the in-built method ConvertTime: https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

    Super easy, super save and just a few lines of code

    This example converts the inputTime from UTC to CET:

    As a source/destination time zone you can use all time zones you can find in your registry under: HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/

    Dim OutlookApp As Object
    Dim TZones As TimeZones
    Dim convertedTime As Date
    Dim inputTime As Date
    Dim sourceTZ As TimeZone
    Dim destTZ As TimeZone
    Dim secNum as Integer
    Set OutlookApp = CreateObject("Outlook.Application")
    Set TZones = OutlookApp.TimeZones
    Set sourceTZ = TZones.Item("UTC")
    Set destTZ = TZones.Item("W. Europe Standard Time")
    inputTime = Now
    Debug.Print "GMT: " & inputTime
    '' the outlook rounds the seconds to the nearest minute
    '' thus, we store the seconds, convert the truncated time and add them later 
    secNum = Second(inputTime)
    inputTime = DateAdd("s",-secNum, inputTime)
    convertedTime = TZones.ConvertTime(inputTime, sourceTZ, destTZ)
    convertedTime = DateAdd("s",secNum, convertedTime)
    Debug.Print "CET: " & convertedTime
    

    PS: if you often have to use the method, I recommend to declare the Outlook object outside of your sub/function. Create it once and keep it alive.

    0 讨论(0)
  • 2020-11-29 09:44

    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
    
    
    0 讨论(0)
  • 2020-11-29 09:45

    Here is the code that is referenced in the answer by 0xA3. I had to change the declare statements to allow it run properly in Office 64bit but I haven't been able to test again in Office 32bit. For my use I was trying to create ISO 8601 dates with timezone information. So i used this function for that.

    Public Function ConvertToIsoTime(myDate As Date, includeTimezone As Boolean) As String
    
        If Not includeTimezone Then
            ConvertToIsoTime = Format(myDate, "yyyy-mm-ddThh:mm:ss")
        Else
            Dim minOffsetLong As Long
            Dim hourOffset As Integer
            Dim minOffset As Integer
            Dim formatStr As String
            Dim hourOffsetStr As String
    
            minOffsetLong = LocalOffsetFromGMT(False, True) * -1
            hourOffset = minOffsetLong \ 60
            minOffset = minOffsetLong Mod 60
    
            If hourOffset >= 0 Then
                hourOffsetStr = "+" + CStr(Format(hourOffset, "00"))
            Else
                hourOffsetStr = CStr(Format(hourOffset, "00"))
            End If
    
            formatStr = "yyyy-mm-ddThh:mm:ss" + hourOffsetStr + ":" + CStr(Format(minOffset, "00"))
            ConvertToIsoTime = Format(myDate, formatStr)
    
    
        End If
    
    End Function
    

    The code below came from http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx

    Option Explicit
    Option Compare Text
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' modTimeZones
    ' By Chip Pearson, chip@cpearson.com, www.cpearson.com
    ' Date: 2-April-2008
    ' Page Specific URL: www.cpearson.com/Excel/TimeZoneAndDaylightTime.aspx
    '
    ' This module contains functions related to time zones and GMT times.
    '   Terms:
    '   -------------------------
    '   GMT = Greenwich Mean Time. Many applications use the term
    '       UTC (Universal Coordinated Time). GMT and UTC are
    '       interchangable in meaning,
    '   Local Time = The local "wall clock" time of day, that time that
    '       you would set a clock to.
    '   DST = Daylight Savings Time
    
    '   Functions In This Module:
    '   -------------------------
    '       ConvertLocalToGMT
    '           Converts a local time to GMT. Optionally adjusts for DST.
    '       DaylightTime
    '           Returns a value indicating (1) DST is in effect, (2) DST is
    '           not in effect, or (3) Windows cannot determine whether DST is
    '           in effect.
    '       GetLocalTimeFromGMT
    '           Converts a GMT Time to a Local Time, optionally adjusting for DST.
    '       LocalOffsetFromGMT
    '           Returns the number of hours or minutes between the local time and GMT,
    '           optionally adjusting for DST.
    '       SystemTimeToVBTime
    '           Converts a SYSTEMTIME structure to a valid VB/VBA date.
    '       LocalOffsetFromGMT
    '           Returns the number of minutes or hours that are to be added to
    '           the local time to get GMT. Optionally adjusts for DST.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Required Types
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
    End Type
    
    Private Type TIME_ZONE_INFORMATION
        Bias As Long
        StandardName(0 To 31) As Integer
        StandardDate As SYSTEMTIME
        StandardBias As Long
        DaylightName(0 To 31) As Integer
        DaylightDate As SYSTEMTIME
        DaylightBias As Long
    End Type
    
    Public Enum TIME_ZONE
        TIME_ZONE_ID_INVALID = 0
        TIME_ZONE_STANDARD = 1
        TIME_ZONE_DAYLIGHT = 2
    End Enum
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Required Windows API Declares
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If VBA7 Then
        Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
    #Else
        Private Declare Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
    #End If
    
    #If VBA7 Then
        Private Declare PtrSafe Sub GetSystemTime Lib "kernel32" _
            (lpSystemTime As SYSTEMTIME)
    #Else
        Private Declare Sub GetSystemTime Lib "kernel32" _
            (lpSystemTime As SYSTEMTIME)
    #End If
    
    
    
    
    Function ConvertLocalToGMT(Optional LocalTime As Date, _
        Optional AdjustForDST As Boolean = False) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ConvertLocalToGMT
    ' This converts a local time to GMT. If LocalTime is present, that local
    ' time is converted to GMT. If LocalTime is omitted, the current time is
    ' converted from local to GMT. If AdjustForDST is Fasle, no adjustments
    ' are made to accomodate DST. If AdjustForDST is True, and DST is
    ' in effect, the time is adjusted for DST by adding
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim T As Date
    Dim TZI As TIME_ZONE_INFORMATION
    Dim DST As TIME_ZONE
    Dim GMT As Date
    
    If LocalTime <= 0 Then
        T = Now
    Else
        T = LocalTime
    End If
    DST = GetTimeZoneInformation(TZI)
    If AdjustForDST = True Then
        GMT = T + TimeSerial(0, TZI.Bias, 0) + _
                IIf(DST = TIME_ZONE_DAYLIGHT, TimeSerial(0, TZI.DaylightBias, 0), 0)
    Else
        GMT = T + TimeSerial(0, TZI.Bias, 0)
    End If
    ConvertLocalToGMT = GMT
    
    End Function
    
    
    Function GetLocalTimeFromGMT(Optional StartTime As Date) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' GetLocalTimeFromGMT
    ' This returns the Local Time from a GMT time. If StartDate is present and
    ' greater than 0, it is assumed to be the GMT from which we will calculate
    ' Local Time. If StartTime is 0 or omitted, it is assumed to be the GMT
    ' local time.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim GMT As Date
    Dim TZI As TIME_ZONE_INFORMATION
    Dim DST As TIME_ZONE
    Dim LocalTime As Date
    
    If StartTime <= 0 Then
        GMT = Now
    Else
        GMT = StartTime
    End If
    DST = GetTimeZoneInformation(TZI)
    LocalTime = GMT - TimeSerial(0, TZI.Bias, 0) + _
            IIf(DST = TIME_ZONE_DAYLIGHT, TimeSerial(1, 0, 0), 0)
    GetLocalTimeFromGMT = LocalTime
    
    End Function
    
    Function SystemTimeToVBTime(SysTime As SYSTEMTIME) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SystemTimeToVBTime
    ' This converts a SYSTEMTIME structure to a VB/VBA date value.
    ' It assumes SysTime is valid -- no error checking is done.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    With SysTime
        SystemTimeToVBTime = DateSerial(.wYear, .wMonth, .wDay) + _
                TimeSerial(.wHour, .wMinute, .wSecond)
    End With
    
    End Function
    
    Function LocalOffsetFromGMT(Optional AsHours As Boolean = False, _
        Optional AdjustForDST As Boolean = False) As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' LocalOffsetFromGMT
    ' This returns the amount of time in minutes (if AsHours is omitted or
    ' false) or hours (if AsHours is True) that should be added to the
    ' local time to get GMT. If AdjustForDST is missing or false,
    ' the unmodified difference is returned. (e.g., Kansas City to London
    ' is 6 hours normally, 5 hours during DST. If AdjustForDST is False,
    ' the resultif 6 hours. If AdjustForDST is True, the result is 5 hours
    ' if DST is in effect.)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim TBias As Long
    Dim TZI As TIME_ZONE_INFORMATION
    Dim DST As TIME_ZONE
    DST = GetTimeZoneInformation(TZI)
    
    If DST = TIME_ZONE_DAYLIGHT Then
        If AdjustForDST = True Then
            TBias = TZI.Bias + TZI.DaylightBias
        Else
            TBias = TZI.Bias
        End If
    Else
        TBias = TZI.Bias
    End If
    If AsHours = True Then
        TBias = TBias / 60
    End If
    
    LocalOffsetFromGMT = TBias
    
    End Function
    
    Function DaylightTime() As TIME_ZONE
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DaylightTime
    ' Returns a value indicating whether the current date is
    ' in Daylight Time, Standard Time, or that Windows cannot
    ' deterimine the time status. The result is a member or
    ' the TIME_ZONE enum.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim TZI As TIME_ZONE_INFORMATION
    Dim DST As TIME_ZONE
    DST = GetTimeZoneInformation(TZI)
    DaylightTime = DST
    End Function
    
    0 讨论(0)
  • 2020-11-29 09:49

    While Outlook may provide a (slow) shortcut to the time zone information, you can go the direct route, but it takes a lot of code for a generic solution - much more than posted above and way too much to post here, partly because some information is localised.

    A core function from my project VBA.Timezone-Windows is this:

    ' Required references:
    '   Windows Script Host Object Model
    '
    ' 2019-12-14. Gustav Brock, Cactus Data ApS, CPH.
    '
    Private Function GetRegistryTimezoneItems( _
        Optional ByRef DynamicDstYear As Integer) _
        As TimezoneEntry()
    
        Const Component     As String = "winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv"
        Const DefKey        As Long = HKeyLocalMachine
        Const HKey          As String = "HKLM"
        Const SubKeyPath    As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
        Const DstPath       As String = "Dynamic DST"
    
        Const DisplayKey    As String = "Display"
        Const DaylightKey   As String = "Dlt"
        Const StandardKey   As String = "Std"
        Const MuiDisplayKey As String = "MUI_Display"
        Const MuiDltKey     As String = "MUI_Dlt"
        Const MuiStdKey     As String = "MUI_Std"
        Const TziKey        As String = "TZI"
        Const FirstEntryKey As String = "FirstEntry"
        Const LastEntryKey  As String = "LastEntry"
       
        Dim SWbemServices   As Object
        Dim WshShell        As WshShell
       
        Dim SubKey          As Variant
        Dim Names           As Variant
        Dim NameKeys        As Variant
       
        Dim Display         As String
        Dim DisplayUtc      As String
        Dim Name            As Variant
        Dim DstEntry        As Variant
        Dim Mui             As Integer
        Dim BiasLabel       As String
        Dim Bias            As Long
        Dim Locations       As String
        Dim TziDetails      As Variant
        Dim TzItems()       As TimezoneEntry
        Dim TzItem          As TimezoneEntry
        Dim Index           As Long
        Dim SubIndex        As Long
        Dim Value           As String
        Dim LBoundItems     As Long
        Dim UBoundItems     As Long
       
        Dim TziInformation  As RegTziFormat
    
        ' The call is either for another year, or
        ' more than one day has passed since the last call.
        Set SWbemServices = GetObject(Component)
        Set WshShell = New WshShell
    
        SWbemServices.EnumKey DefKey, SubKeyPath, Names
        ' Retrieve all timezones' base data.
        LBoundItems = LBound(Names)
        UBoundItems = UBound(Names)
        ReDim TzItems(LBoundItems To UBoundItems)
       
        For Index = LBound(Names) To UBound(Names)
            ' Assemble paths and look up key values.
            SubKey = Names(Index)
           
            ' Invariant name of timezone.
            TzItem.Name = SubKey
           
            ' MUI of the timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, MuiDisplayKey), "\")
            Value = WshShell.RegRead(Name)
            Mui = Val(Split(Value, ",")(1))
            TzItem.Mui = Mui
            ' MUI of the standard timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, MuiStdKey), "\")
            Value = WshShell.RegRead(Name)
            Mui = Val(Split(Value, ",")(1))
            TzItem.MuiStandard = Mui
            ' MUI of the DST timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, MuiDltKey), "\")
            Value = WshShell.RegRead(Name)
            Mui = Val(Split(Value, ",")(1))
            TzItem.MuiDaylight = Mui
           
            ' Localised description of the timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, DisplayKey), "\")
            Display = WshShell.RegRead(Name)
            ' Extract the first part, cleaned like "UTC+08:30".
            DisplayUtc = Mid(Split(Display, ")", 2)(0) & "+00:00", 2, 9)
            ' Extract the offset part of first part, like "+08:30".
            BiasLabel = Mid(Split(Display, ")", 2)(0) & "+00:00", 5, 6)
            ' Convert the offset part of the first part to a bias value (signed integer minutes).
            Bias = -Val(Left(BiasLabel, 1) & Str(CDbl(CDate(Mid(BiasLabel, 2))) * 24 * 60))
            ' Extract the last part, holding the location(s).
            Locations = Split(Display, " ", 2)(1)
            TzItem.Bias = Bias
            TzItem.Utc = DisplayUtc
            TzItem.Locations = Locations
           
            ' Localised name of the standard timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, StandardKey), "\")
            TzItem.ZoneStandard = WshShell.RegRead(Name)
            ' Localised name of the DST timezone.
            Name = Join(Array(HKey, SubKeyPath, SubKey, DaylightKey), "\")
            TzItem.ZoneDaylight = WshShell.RegRead(Name)
           
            ' TZI details.
            SWbemServices.GetBinaryValue DefKey, Join(Array(SubKeyPath, SubKey), "\"), TziKey, TziDetails
            FillRegTziFormat TziDetails, TziInformation
            TzItem.Tzi = TziInformation
            ' Default Dynamic DST range.
            TzItem.FirstEntry = Null
            TzItem.LastEntry = Null
           
            ' Check for Dynamic DST info.
            SWbemServices.EnumKey DefKey, Join(Array(SubKeyPath, SubKey), "\"), NameKeys
            If IsArray(NameKeys) Then
                ' This timezone has subkeys. Check if Dynamic DST is present.
                For SubIndex = LBound(NameKeys) To UBound(NameKeys)
                    If NameKeys(SubIndex) = DstPath Then
                        ' Dynamic DST details found.
                        ' Record first and last entry.
                        DstEntry = Join(Array(HKey, SubKeyPath, SubKey, DstPath, FirstEntryKey), "\")
                        Value = WshShell.RegRead(DstEntry)
                        TzItem.FirstEntry = Value
                        DstEntry = Join(Array(HKey, SubKeyPath, SubKey, DstPath, LastEntryKey), "\")
                        Value = WshShell.RegRead(DstEntry)
                        TzItem.LastEntry = Value
                       
                        If DynamicDstYear >= TzItems(Index).FirstEntry And _
                            DynamicDstYear <= TzItems(Index).LastEntry Then
                            ' Replace default TZI details with those from the dynamic DST.
                            DstEntry = Join(Array(SubKeyPath, SubKey, DstPath), "\")
                            SWbemServices.GetBinaryValue DefKey, Join(Array(SubKeyPath, SubKey), "\"), , CStr(DynamicDstYear), TziDetails
                            FillRegTziFormat TziDetails, TziInformation
                            TzItem.Tzi = TziInformation
                        Else
                            ' Dynamic DST year was not found.
                            ' Return current year.
                            DynamicDstYear = Year(Date)
                        End If
                        Exit For
                    End If
                Next
            End If
            TzItems(Index) = TzItem
        Next
       
        GetRegistryTimezoneItems = TzItems
       
    End Function
    

    The project is supported by two articles:

    Time Zones, Windows, and VBA - Part 1

    Time Zones, Windows, and Microsoft Office - Part 2

    including demos for Access and Excel.

    0 讨论(0)
  • 2020-11-29 09:52

    VBA doesn't offer functions to do that, but the Windows API does. Luckily you can use all those functionality from VBA as well. This page describes how to do it: Time Zones & Daylight Savings Time


    Edit: Added Code

    For the posterity sake, I've added the complete code from Guru Chip's page, as usable in 32-bit Office VBA. (64-bit modification here)

    Option Explicit
    Option Compare Text
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' modTimeZones
    ' By Chip Pearson, used with permission from www.cpearson.com
    ' Date: 2-April-2008
    ' Page Specific URL: www.cpearson.com/Excel/TimeZoneAndDaylightTime.aspx
    '
    ' This module contains functions related to time zones and GMT times.
    '   Terms:
    '   -------------------------
    '   GMT = Greenwich Mean Time. Many applications use the term
    '       UTC (Universal Coordinated Time). GMT and UTC are
    '       interchangable in meaning,
    '   Local Time = The local "wall clock" time of day, that time that
    '       you would set a clock to.
    '   DST = Daylight Savings Time
    
    '   Functions In This Module:
    '   -------------------------
    '       ConvertLocalToGMT
    '           Converts a local time to GMT. Optionally adjusts for DST.
    '       DaylightTime
    '           Returns a value indicating (1) DST is in effect, (2) DST is
    '           not in effect, or (3) Windows cannot determine whether DST is
    '           in effect.
    '       GetLocalTimeFromGMT
    '           Converts a GMT Time to a Local Time, optionally adjusting for DST.
    '       LocalOffsetFromGMT
    '           Returns the number of hours/minutes between the local time &GMT,
    '           optionally adjusting for DST.
    '       SystemTimeToVBTime
    '           Converts a SYSTEMTIME structure to a valid VB/VBA date.
    '       LocalOffsetFromGMT
    '           Returns the number of minutes or hours that are to be added to
    '           the local time to get GMT. Optionally adjusts for DST.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ' Required Types
    Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
    End Type
    
    Private Type TIME_ZONE_INFORMATION
        Bias As Long
        StandardName(0 To 31) As Integer
        StandardDate As SYSTEMTIME
        StandardBias As Long
        DaylightName(0 To 31) As Integer
        DaylightDate As SYSTEMTIME
        DaylightBias As Long
    End Type
    
    Public Enum TIME_ZONE
        TIME_ZONE_ID_INVALID = 0
        TIME_ZONE_STANDARD = 1
        TIME_ZONE_DAYLIGHT = 2
    End Enum
    
    ' Required Windows API Declares
    Private Declare Function GetTimeZoneInformation Lib "kernel32" _
        (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
    
    Private Declare Sub GetSystemTime Lib "kernel32" _
        (lpSystemTime As SYSTEMTIME)
    
    Function ConvertLocalToGMT(Optional LocalTime As Date, _
        Optional AdjustForDST As Boolean = False) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ConvertLocalToGMT
    ' This converts a local time to GMT. If LocalTime is present, that local
    ' time is converted to GMT. If LocalTime is omitted, the current time is
    ' converted from local to GMT. If AdjustForDST is Fasle, no adjustments
    ' are made to accomodate DST. If AdjustForDST is True, and DST is
    ' in effect, the time is adjusted for DST by adding
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim T As Date
        Dim TZI As TIME_ZONE_INFORMATION
        Dim DST As TIME_ZONE
        Dim GMT As Date
    
        If LocalTime <= 0 Then
            T = Now
        Else
            T = LocalTime
        End If
        DST = GetTimeZoneInformation(TZI)
        If AdjustForDST = True Then
            GMT = T + TimeSerial(0, TZI.Bias, 0) + _
                    IIf(DST=TIME_ZONE_DAYLIGHT,TimeSerial(0, TZI.DaylightBias,0),0)
        Else
            GMT = T + TimeSerial(0, TZI.Bias, 0)
        End If
        ConvertLocalToGMT = GMT
    End Function
    
    Function GetLocalTimeFromGMT(Optional StartTime As Date) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' GetLocalTimeFromGMT
    ' This returns the Local Time from a GMT time. If StartDate is present and
    ' greater than 0, it is assumed to be the GMT from which we will calculate
    ' Local Time. If StartTime is 0 or omitted, it is assumed to be the GMT
    ' local time.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim GMT As Date
        Dim TZI As TIME_ZONE_INFORMATION
        Dim DST As TIME_ZONE
        Dim LocalTime As Date
    
        If StartTime <= 0 Then
            GMT = Now
        Else
            GMT = StartTime
        End If
        DST = GetTimeZoneInformation(TZI)
        LocalTime = GMT - TimeSerial(0, TZI.Bias, 0) + _
                IIf(DST = TIME_ZONE_DAYLIGHT, TimeSerial(1, 0, 0), 0)
        GetLocalTimeFromGMT = LocalTime
    End Function
    
    Function SystemTimeToVBTime(SysTime As SYSTEMTIME) As Date
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SystemTimeToVBTime
    ' This converts a SYSTEMTIME structure to a VB/VBA date value.
    ' It assumes SysTime is valid -- no error checking is done.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        With SysTime
            SystemTimeToVBTime = DateSerial(.wYear, .wMonth, .wDay) + _
                    TimeSerial(.wHour, .wMinute, .wSecond)
        End With
    End Function
    
    Function LocalOffsetFromGMT(Optional AsHours As Boolean = False, _
        Optional AdjustForDST As Boolean = False) As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' LocalOffsetFromGMT
    ' This returns the amount of time in minutes (if AsHours is omitted or
    ' false) or hours (if AsHours is True) that should be added to the
    ' local time to get GMT. If AdjustForDST is missing or false,
    ' the unmodified difference is returned. (e.g., Kansas City to London
    ' is 6 hours normally, 5 hours during DST. If AdjustForDST is False,
    ' the resultif 6 hours. If AdjustForDST is True, the result is 5 hours
    ' if DST is in effect.)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim TBias As Long
        Dim TZI As TIME_ZONE_INFORMATION
        Dim DST As TIME_ZONE
        DST = GetTimeZoneInformation(TZI)
    
        If DST = TIME_ZONE_DAYLIGHT Then
            If AdjustForDST = True Then
                TBias = TZI.Bias + TZI.DaylightBias
            Else
                TBias = TZI.Bias
            End If
        Else
            TBias = TZI.Bias
        End If
        If AsHours = True Then
            TBias = TBias / 60
        End If
    
        LocalOffsetFromGMT = TBias
    End Function
    
    Function DaylightTime() As TIME_ZONE
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DaylightTime
    ' Returns a value indicating whether the current date is
    ' in Daylight Time, Standard Time, or that Windows cannot
    ' deterimine the time status. The result is a member or
    ' the TIME_ZONE enum.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim TZI As TIME_ZONE_INFORMATION
        Dim DST As TIME_ZONE
        DST = GetTimeZoneInformation(TZI)
        DaylightTime = DST
    End Function
    
    0 讨论(0)
  • 2020-11-29 09:52

    Please be aware of little trap in the solution.

    The GetTimeZoneInformation() call returns DST info about the current time, but the converted date might be from the period with the different DST setting - thus converting January date in August would apply the current Bias, thus yielding the GMT date 1 hour less than the correct one (SystemTimeToTzSpecificLocalTime seems to be a better fit - untested yet)

    The same applies when the date is from another year - when DST rules might have been different. GetTimeZoneInformationForYear should handle changes in different years. I'll put a code sample here once completed.

    It also seems Windows does not provide a reliable way to get 3 letter abbreviation of the timezone (Excel 2013 supports zzz in Format() - not tested).

    Edit 16.04.2015: IntArrayToString() removed as it is already present in modWorksheetFunctions.bas referenced in below mentioned cpearson.com articles.

    Adding code to convert using timezone active at the time of the converted date (this issue is not addressed on cpearson.com). Error handling is not included for brevity.

    Private Type DYNAMIC_TIME_ZONE_INFORMATION_VB
        Bias As Long
        StandardName As String
        StandardDate As Date
        StandardBias As Long
        DaylightName As String
        DaylightDate As Date
        DaylightBias As Long
        TimeZoneKeyName As String
        DynamicDaylightTimeDisabled As Long
    End Type
    
    Private Declare Function GetTimeZoneInformationForYear Lib "kernel32" ( _
        wYear As Integer, _
        lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _
        lpTimeZoneInformation As TIME_ZONE_INFORMATION _
    ) As Long
    
    Private Declare Function GetDynamicTimeZoneInformation Lib "kernel32" ( _
        pTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION _
    ) As Long
    
    Private Declare Function TzSpecificLocalTimeToSystemTimeEx Lib "kernel32" ( _
        lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _
        lpLocalTime As SYSTEMTIME, _
        lpUniversalTime As SYSTEMTIME _
    ) As Long
    
    Function LocalSerialTimeToGmt(lpDateLocal As Date) As Date
        Dim retval As Boolean, lpDateGmt As Date, lpSystemTimeLocal As SYSTEMTIME, lpSystemTimeGmt As SYSTEMTIME
        Dim lpDTZI As DYNAMIC_TIME_ZONE_INFORMATION 
    
        retval = SerialTimeToSystemTime(lpDateLocal, lpSystemTimeLocal)
        retval = GetDynamicTimeZoneInformation(lpDTZI)
        retval = TzSpecificLocalTimeToSystemTimeEx(lpDTZI, lpSystemTimeLocal, lpSystemTimeGmt)
        lpDateGmt = SystemTimeToSerialTime(lpSystemTimeGmt)
        LocalSerialTimeToGmt = lpDateGmt
    End Function
    

    There are 2 ways to achieve offset:

    1. subtract local date and converted gmt date:

      offset = (lpDateLocal - lpDateGmt)*24*60

    2. get TZI for specific year and calculate:

      dst = GetTimeZoneInformationForYear(Year(lpDateLocal), lpDTZI, lpTZI) offset = lpTZI.Bias + IIf(lpDateLocal >= SystemTimeToSerialTime(lpTZI.DaylightDate) And lpDateLocal < SystemTimeToSerialTime(lpTZI.StandardDate), lpTZI.DaylightBias, lpTZI.StandardBias)

    Caveat: For some reason, values populated in lpTZI here do not contain the year information, so you need to set the year in lpTZI.DaylightDate and lpTZI.StandardDate.

    0 讨论(0)
提交回复
热议问题