【问题标题】:Get Timezone Information in VBA (Excel)在 VBA (Excel) 中获取时区信息
【发布时间】:2011-03-08 10:44:34
【问题描述】:

我想在 VBA 中的特定日期确定不同国家/地区与 GMT/UTC(包括夏令时)的时间偏移量。有任何想法吗?

编辑(来自自我回答):

谢谢 0xA3。我快速阅读了链接页面。我假设您只能获得运行 Windows 的本地的 GMT 偏移量:

ConvertLocalToGMT    
DaylightTime  
GetLocalTimeFromGMT          
LocalOffsetFromGMT
SystemTimeToVBTime
LocalOffsetFromGMT

在 Java 中,您可以执行以下操作:

TimeZone bucharestTimeZone = TimeZone.getTimeZone("Europe/Bucharest");
    bucharestTimeZone.getOffset(new Date().getTime());

Calendar nowInBucharest = Calendar.getInstance(TimeZone.getTimeZone("Europe/Bucharest"));
    nowInBucharest.setTime(new Date());
    System.out.println("Bucharest: " + nowInBucharest.get(Calendar.HOUR) + ":" + nowInBucharest.get(Calendar.MINUTE));

这意味着我可以获得不同国家(时区)的偏移量,因此我也可以获得布加勒斯特的实际时间。我可以在 VBA 中执行此操作吗?

【问题讨论】:

    标签: excel vba timezone dst


    【解决方案1】:

    VBA 不提供执行此操作的函数,但 Windows API 提供。幸运的是,您也可以使用 VBA 中的所有这些功能。本页介绍了如何操作:Time Zones & Daylight Savings Time


    编辑:添加代码

    为了后代,我添加了 Guru Chip 页面中的完整代码,可在 32 位 Office VBA 中使用。 (64位修改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
    

    【讨论】:

    • +1 但我建议也在这里粘贴(或写,如果您认为可能出现版权问题)相关代码。如果源站点出现故障,它将保留在这里以供将来参考
    • @belisarius:好点子,希望我或其他人以后有时间这样做;-)
    • 我添加了代码作为问题的附加答案。尽管我不得不对 Declare 语句进行更改以使其在 Office 64 位上正常工作。
    • Chip Pearson 的site 已经关闭了 2 天...我感觉不完整。 :-(
    • @ashleedawg:您可以在此处访问存档版本:web.archive.org/web/20171017030345/http://www.cpearson.com/…
    【解决方案2】:

    请注意解决方案中的小陷阱。

    GetTimeZoneInformation() 调用返回有关当前时间的 DST 信息,但转换后的日期可能来自具有不同 DST 设置的时期 - 因此在 8 月转换 1 月日期将应用当前偏差,因此产生的 GMT 日期比正确日期少 1 小时(SystemTimeToTzSpecificLocalTime 似乎更合适 - 尚未测试)

    当日期来自另一年时,同样适用 - 当 DST 规则可能不同时。 GetTimeZoneInformationForYear 应该处理不同年份的变化。完成后我会在这里放一个代码示例。

    Windows 似乎也没有提供可靠的方法来获取时区的 3 个字母缩写(Excel 2013 支持 Format() 中的 zzz - 未测试)。

    Edit 16.04.2015:IntArrayToString() 已被删除,因为它已经存在于下面提到的 cpearson.com 文章中引用的 modWorksheetFunctions.bas 中。

    添加代码以使用转换日期时活动的时区进行转换(cpearson.com 上未解决此问题)。为简洁起见,不包括错误处理。

    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
    

    有2种方法可以实现偏移:

    1. 减去本地日期和转换后的GMT日期:

      offset = (lpDateLocal - lpDateGmt)*24*60

    2. 获取特定年份的 TZI 并计算:

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

    注意:由于某种原因,此处填写在 lpTZI 中的值不包含年份信息,因此您需要在 lpTZI.DaylightDate 和 lpTZI.StandardDate 中设置年份。

    【讨论】:

    • 值得注意的陷阱:伦敦和纽约每年都有7天的时间处于不同的夏令时模式。如果您从这两个位置的应用程序中导入带时间戳的数据,您在此期间遇到此陷阱。
    • 最让我吃惊的是,没有人使用 VBA 报告同样的问题,即使是很棒的 cpearson 脚本也不能处理这个问题(甚至在你自己的时区处理 6 个月前的数据,你必须偶然发现)。
    【解决方案3】:

    这是 0xA3 在答案中引用的代码。我不得不更改声明语句以使其在 Office 64 位中正常运行,但我无法在 Office 32 位中再次测试。对于我的使用,我试图创建带有时区信息的 ISO 8601 日期。所以我为此使用了这个功能。

    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
    

    以下代码来自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
    

    【讨论】:

      【解决方案4】:

      我建议创建一个 Outlook 对象并使用内置方法 ConvertTimehttps://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

      超级简单,超级省钱,只需几行代码

      此示例将 inputTime 从 UTC 转换为 CET:

      作为源/目的地时区,您可以使用您能找到的所有时区 在您的注册表中: 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:如果您经常需要使用该方法,我建议您在子/函数之外声明 Outlook 对象。创建一次并保持活动状态。

      【讨论】:

      • 这看起来很有趣,但是您如何提供源和目标时区?你能不能提供一个小样本?谢谢
      • 谢谢。但是,提供的代码似乎无法编译。 ConvertTime 需要 TimeZone 对象作为 2d 和 3d 参数,而不是字符串。
      • @PatrickHonorez 请刷新页面以查看正确的代码
      • 超级!它不仅有效,而且似乎知道我们现在处于夏令时 (DST)。因此,如果我想将时间从波士顿转换为 LUX,只要我在事件发生的同一天计算它,这应该全年有效,对吧?
      • 你甚至不需要在活动的同一天!这也适用于 DST 与当前日期不同的历史日期!!!!这是使用 Outlook 的内置方法的巨大优势。当然,Outlook 的日历需要能够处理 DST :-) 奇怪的是还没有人想出这个想法....
      【解决方案5】:

      基于 Julian Hess 对使用 Outlook 功能的出色建议,我构建了这个模块,它可以与 Access 和 Excel 一起使用。

      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
      
      Private oOutl As Object 'keep Outlook reference active, to save time in recurring calls
      Private oOutlTimeZones As Object 'keep Outlook reference active, to save time in recurring calls
      ' seems to drop the reference if use previous scheme of returning boolean
      ' returning the actual object is more correct in any case
      Private Function GetOutlookTimeZones() As Object
          If oOutl Is Nothing Or oOutlTimeZones 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
              Set oOutlTimeZones = oOutl.TimeZones
          End If
          Set GetOutlookTimeZones = oOutlTimeZones
          On Error GoTo 0
      End Function
      
      Function ConvertTime(DT As Date, Optional TZfrom As String = "Central Standard Time", _
                                       Optional TZto As String = "W. Europe Standard Time") 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 sourceTZ As Object
          Dim destTZ As Object
          Dim seconds As Single
          Dim DT_SecondsStripped As Date
          Dim oOutlTimeZones As Object: Set oOutlTimeZones = GetOutlookTimeZones()
          If Not (oOutlTimeZones Is Nothing) 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 sourceTZ = oOutlTimeZones.Item(TZfrom)
              Set destTZ = oOutlTimeZones.Item(TZto)
              ConvertTime = oOutlTimeZones.ConvertTime(DT_SecondsStripped, sourceTZ, destTZ) + seconds    'add the stripped seconds
          End If
      End Function
      
      ' returns number of minutes ahead of UTC (positive number) or behind
      Function GetOffsetAt(DT As Date, TZfrom As String) As Long
          Dim utc_DT As Date: utc_DT = ConvertTime(DT, TZfrom, "UTC")
          GetOffsetAt = DateDiff("n", utc_DT, DT)
      End Function
      
      Sub test_ConvertTime()
          Dim t As Date: t = #8/23/2017 6:15:05 AM#
          Debug.Print t, ConvertTime(t), Format(t - ConvertTime(t), "h")
          Debug.Print t, ConvertTime(t, "Central Standard Time", "W. Europe Standard Time"), Format(t - ConvertTime(t), "h")
      End Sub
      
      Sub test_DumpTZs()
          Dim TZ As Object: For Each TZ In GetOutlookTimeZones()
              Debug.Print "TZ:", TZ.Id, TZ.Name
          Next TZ
      End Sub
      

      【讨论】:

      • 您的 GetOutLook 函数可以只使用 Set oOutl = CreateObject("Outlook.Application") - 一次只能打开一个 Outlook 实例,因此在这种情况下,CreateObject 会获取已打开的对象....现在必须找到支持我的主张的文件。
      • 看起来不错。我将该代码用于 Excel,并认为它可以通过 Outlook 节省几毫秒,但实际上我认为你是对的:一个只能运行一个 Outlook 实例。很容易测试,但现在我在他们使用的地方有一个合同......Lotus Notes 8-((
      • 这太棒了——它可能应该是排名最高的答案!从 cmets 看来,基于 Windows API 的两个答案都存在错误,并且涉及更多代码。我更喜欢所有实际算术都由 Outlook 完成的解决方案。我只是要编辑您的答案,以添加对有效时区的魔术字符串列表的引用。谢谢!
      • 我还添加了一个GetOffsetAt,例如用于计算 ISO8601 时间戳的正确偏移量。
      • 不错的一个!您还可以使用该对象获取您的本地时区:Debug.Print oOutlTimeZones.CurrentTimeZone.id
      【解决方案6】:

      虽然 Outlook 可能会为时区信息提供(慢速)快捷方式,但您可以直接使用,但通用解决方案需要大量代码 - 比上面发布的要多得多,在此处发布的内容也太多了,部分原因是某些信息是本地化的。

      我的项目VBA.Timezone-Windows 的核心功能是这样的:

      ' 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
      

      该项目有两篇文章支持:

      Time Zones, Windows, and VBA - Part 1

      Time Zones, Windows, and Microsoft Office - Part 2

      包括 Access 和 Excel 的演示。

      【讨论】:

        【解决方案7】:

        以下是几个可能有用的函数,它们将 IsDST 的返回值与 CheckDST 进行比较,然后相应地调整时区日期/时间值。例如:

        Dim SomeDateTime As Date 'Or Double
        
        If IsDST Then
            'Is currently DST, so add an hour if the date/time to be checked includes a standard-time date.
            
            If Not CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime + TimeSerial(1, 0, 0)
        Else
            'Is not currently DST, so subtract an hour if the date/time to be checked includes a DST date.
            
            If CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime - TimeSerial(1, 0, 0)
        End If
        

        CheckDST:全功能版本。如果夏令时(或英国夏令时)适用于指定日期(在可选指定的语言环境中),则返回 True;否则返回 False。处理自 1966 年以来的所有美国 DST(和英国 BST)系统变化,包括 1973 年尼克松总统的“紧急夏令时节能法”和 1968 年 10 月 27 日至 1971 年 10 月 31 日 Harold Wilson 的“英国标准时间”实验。

        CheckDST_UK1972:简化版。如果 UK British Summer Time 适用于指定日期,则返回 True,基于自 1972 年以来定义的 BS​​T 系统;否则返回 False。

        CheckDST_US2007:简化版。如果美国联邦夏令时适用于指定日期,则返回 True,基于 2007 年建立的 DST 系统;否则返回 False。

        IsDST:如果夏令时当前有效(在可选指定的语言环境中),则返回 True;否则返回 False。

        NthDayOfWeekDate:返回指定月份中指定星期几的指定第 N 个实例的日期。

        Option Explicit
        
        Public Function CheckDST(ChkDate As Variant, Optional Locale As String = "USA") As Boolean
            '
            'Returns True if Daylight Savings Time applies to the specified date (in the optionally specified locale);
            'otherwise returns False.  Note that this function handles all dates back to 1/1/1966.  For dates prior to
            'that, an error message is displayed due to the difficulty of handling the highly inconsistent use of DST in
            'prior years, across various locales.
            '
            'PARAMETERS:
            '
            '   ChkDate     The date to be checked for DST status.  The data-type of the calling code's argument can
            '               be either Date or Double.
            '
            '   Locale      The geographic locale within which that locale's DST rules are to be applied. Values:
            '                   "AZ"    - DST hasn't applied to Arizona since 1967.
            '                   "NN"    - DST has applied in the Navajo Nation of northeastern Arizona.
            '                   "AS"    - DST has never applied in American Samoa (since WWII).
            '                   "GU"    -   "   Guam.
            '                   "HI"    -   "   Hawaii.
            '                   "MP"    -   "   Northern Marina Islands.
            '                   "PR"    -   "   Puerto Rico.
            '                   "VI"    -   "   Virgin Islands.
            '                   "UK"    - British Summer Time (BST) has been applied since the end of WWII (1945), from
            '                             the last Sunday of March through the last Sunday of October, with one exception
            '                             period from 1968 through 1971 in which it applied all year long (see details
            '                             below).
            '                   "USA"   - All other states in the US, for which the federal DST rules have applied.
            '                             Correctly handles President Nixon's "Emergency Daylight Saving Time Energy
            '                             Conservation Act" of 1973.
            '
            'AUTHOR: Peter Straton
            '
            '*************************************************************************************************************
        
            Const ThisFunction As String = "Function CheckDST()"
        
            Const First As Integer = 1  'First instance in a month
            Const Secnd As Integer = 2  'Second instance in a month
            Const Last  As Integer = 5  'Last instance: use max possible in a month
        
            Const Mar As Integer = 3, Apr As Integer = 4, Oct As Integer = 10, Nov As Integer = 11
        
            Const LawYearIdx As Integer = 0, StartInstanceIdx As Integer = 1, StartMonthIdx As Integer = 2, _
                  EndInstanceIdx As Integer = 3, EndMonthIdx As Integer = 4
        
            Dim DateYear As Integer
            Dim i As Integer
            Dim StartInstance As Integer, StartMonth As Integer, EndInstance As Integer, EndMonth As Integer
            Static US_StartEndSpecs As Variant
        
            DateYear = Year(ChkDate)
            If DateYear < 1966 Then
                MsgBox "The specified date, " & ChkDate & ", is prior to this function's minimum date-year (1966) " & _
                       "which is necessary due to highly inconsistent use of DST in prior years, over various locales.", _
                       vbOKOnly + vbCritical, ThisFunction
                Exit Function  'Return default: False
            End If
        
            Select Case Locale
            Case "USA", "NN"    'Check these cases first, for execution efficiency and locale-logic shortcut
                If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/26/1975") Then
                    'Non-algorithmic case: On January 4, 1974, President Nixon signed the Emergency Daylight Saving Time
                    'Energy Conservation Act of 1973.  Beginning on January 6, 1974, clocks were set ahead. On October 5,
                    '1974, Congress amended the Act, and Standard Time returned on October 27, 1974. Daylight Saving Time
                    'resumed on February 23, 1975 and ended on October 26, 1975.
                    '
                    'NOTE: Arizona was exempted.
        
                    If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/27/1975") Or _
                       ChkDate >= DateValue("2/23/1975") And ChkDate < DateValue("10/26/1975") Then
        
                        CheckDST = True
                        Exit Function
                    End If
                'Else
                    'Continue with DST calculation below...
                End If
        
            Case "UK"   'Check this case next, for execution efficiency and locale-logic shortcut
                If ChkDate >= DateValue("10/27/1968") And ChkDate < DateValue("10/31/1971") Then
                    'Non-algorithmic case: The Harold Wilson government adopted "British Standard Time" (actually GMT+1,
                    'equivalent to DST) *throughout* the year.  This took place between October 27, 1968 and October 31,
                    '1971 when there was a reversion back to the previous arrangement.
        
                    CheckDST = True
                    Exit Function   'Return default: False
                'Else
                    'Continue with DST calculation below...
                End If
        
                StartInstance = Last: StartMonth = Mar 'Last Sunday of March
                EndInstance = Last: EndMonth = Oct     'Last Sunday of October
        
            Case "AZ"
                If DateYear > 1967 Then Exit Function   'Hasn't participated in DST since 1967; return default: False
        
            Case "AS", "GU", "HI", "MP", "PR", "VI"
                Exit Function  'None of these have participated in DST (since WWII); return default: False
        
            Case Else
                MsgBox "Unknown Locale specification: """ & Locale & """", vbOKOnly + vbCritical, ThisFunction
            End Select
        
            If StartInstance = 0 Then '(If not defined above)
                'If necessary, (re)initialize the DST start/end specs by DST law-date lookup table for the USA, then find
                'the DST rule specs that apply, based on the specified date's year vs. the rule start-date years.
        
                If IsEmpty(US_StartEndSpecs) Then '(Re)init if necessary...
                    US_StartEndSpecs = Array(Array(2007, Secnd, Mar, First, Nov), _
                                             Array(1986, First, Mar, Last, Oct), _
                                             Array(1966, Last, Apr, Last, Oct))
                End If
                For i = LBound(US_StartEndSpecs, 1) To UBound(US_StartEndSpecs, 1)
                    If DateYear >= US_StartEndSpecs(i)(LawYearIdx) Then Exit For
                Next i
                If i > UBound(US_StartEndSpecs, 1) Then
                    Stop 'DEBUG: SHOULD NEVER EXECUTE TO HERE DUE TO ChkDate PARAMETER VALUE CHECK, ABOVE.
                    Exit Function
                End If
        
                StartInstance = US_StartEndSpecs(i)(StartInstanceIdx)   'n-th Sunday of...
                StartMonth = US_StartEndSpecs(i)(StartMonthIdx)         'some month
                EndInstance = US_StartEndSpecs(i)(EndInstanceIdx)       'm-th Sunday of...
                EndMonth = US_StartEndSpecs(i)(EndMonthIdx)             'some other month
            End If
        
            'Do the DST calculation based on the specifications defined above
        
            CheckDST = ChkDate >= NthDayOfWeekDate(StartInstance, vbSunday, DateSerial(DateYear, StartMonth, 1)) And _
                       ChkDate < NthDayOfWeekDate(EndInstance, vbSunday, DateSerial(DateYear, EndMonth, 1))
        End Function 'CheckDST
        
        Public Function CheckDST_UK1972(ChkDate As Date) As Boolean
            '
            'Returns True if the UK "British Summer Time" applies to the specified date, based on the BST system as it's
            'been defined since 1972; otherwise returns False.  Note that this function does not take into account Harold
            'Wilson's experimental "British Standard Time" which took place between October 27, 1968 and October 31, 1971.
            'To correctly handle that date range, use the CheckDST function instead.
            '
            'PARAMETERS:
            '
            '   ChkDate     The date to be checked for DST status.
            '
            'AUTHOR: Peter Straton
            '
            '*************************************************************************************************************
        
            Const Last As Integer = 5   'Last instance: use max possible in a month
            Const Mar As Integer = 3, Oct As Integer = 10
            Dim DateYear As Integer: DateYear = Year(ChkDate)
        
            CheckDST_UK1972 = ChkDate >= NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Mar, 1)) And _
                              ChkDate < NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Oct, 1))
        End Function 'CheckDST_UK1972
        
        Public Function CheckDST_US2007(ChkDate As Date) As Boolean
            '
            'Returns True if the US Federal "Daylight Savings Time" applies to the specified date, based on the DST system
            'established in 2007; otherwise returns False.  Note that this function does not take into account locales
            'such as Arizona, Hawaii or various US protectorates (Puerto Rico, Guam, etc.) so results for those locales
            'will be unreliable.  To correctly handle those locales, use the CheckDST function instead.
            '
            'PARAMETERS:
            '
            '   ChkDate     The date to be checked for DST status.
            '
            'AUTHOR: Peter Straton
            '
            '*************************************************************************************************************
        
            Const First As Integer = 1  'First instance in a month
            Const Secnd As Integer = 2  'Second instance in a month
            Const Mar As Integer = 3, Nov As Integer = 11
            Dim DateYear As Integer: DateYear = Year(ChkDate)
        
            CheckDST_US2007 = ChkDate >= NthDayOfWeekDate(Secnd, vbSunday, DateSerial(DateYear, Mar, 1)) And _
                              ChkDate < NthDayOfWeekDate(First, vbSunday, DateSerial(DateYear, Nov, 1))
        End Function 'CheckDST_US2007
        
        Public Function IsDST(Optional Locale As String = "USA") As Boolean
            '
            'Returns True if Daylight Savings Time is *currently* in effect (in the optionally specified locale);
            'otherwise returns False.
            '
            '*************************************************************************************************************
        
            IsDST = CheckDST(Now(), Locale)
        End Function
        
        Function NthDayOfWeekDate(ByVal Instance As Integer, DayOfWeek As Integer, ByVal MonthDate As Date) As Date
            '
            'Returns the Date of the specified Nth instance of the specified day-of-week in the specified month.
            '
            'PARAMETERS:
            '
            '   Instance    The instance-number specified day-of-week in the month.  To get the date of *last* instance in
            '               the month of the specified day-of-week, pass the value 5 as the argument to this parameter.
            '
            '   DayOfWeek   The day-number of the day-of-week for which the Nth instance is to be calculated.  Can be any
            '               of: vbSunday, vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday, vbSaturday.
            '
            '   MonthDate   The date of the month in which the Nth day-of-week instance is to be calculated.
            '               (e.g. "3/2020" or "3/1/2020")
            '
            'AUTHOR: Peter Straton
            '
            '*************************************************************************************************************
        
            Instance = IIf(Instance > 5, 5, Instance)   'Max: 5 possible instances
        
            MonthDate = DateSerial(Year(MonthDate), Month(MonthDate), 1) 'Ensure that it's the first day of the month
            NthDayOfWeekDate = MonthDate + Instance * 7 - Weekday(MonthDate + 7 - DayOfWeek)
        
            If Month(NthDayOfWeekDate) <> Month(MonthDate) Then NthDayOfWeekDate = NthDayOfWeekDate - 7 '"Last" instance?
        End Function
        

        【讨论】:

          【解决方案8】:

          对 Patrick Honorez 的出色解决方案进行了一些调整。

          一些错误检查和一些额外的测试。 :-)

          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
          
          

          【讨论】:

          • 一个调用 MsgBox 的函数?这是一个非常糟糕的主意。
          猜你喜欢
          • 1970-01-01
          • 1970-01-01
          • 2013-08-09
          • 2023-03-23
          • 2010-11-09
          • 1970-01-01
          • 2012-08-20
          • 1970-01-01
          相关资源
          最近更新 更多