在VBA中获取时区信息(Excel)

Mar*_*enz 17 excel timezone vba excel-vba dst

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

编辑(来自自我回答):

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

ConvertLocalToGMT    
DaylightTime  
GetLocalTimeFromGMT          
LocalOffsetFromGMT
SystemTimeToVBTime
LocalOffsetFromGMT
Run Code Online (Sandbox Code Playgroud)

在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));
Run Code Online (Sandbox Code Playgroud)

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

Dir*_*mar 11

VBA不提供执行此操作的功能,但Windows API可以执行此操作.幸运的是,您也可以使用VBA的所有功能.此页面介绍了如何执行此操作:时区和夏令时


编辑:添加代码

为了后人的缘故,我在Guru Chip的页面中添加了完整的代码,可以在32位Office VBA中使用.(这里有 64位修改)

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
Run Code Online (Sandbox Code Playgroud)

  • +1但我建议在这里粘贴(或写作,如果您认为可能出现版权问题)相关代码.如果源站点出现故障,它将留在此处以供将来参考 (3认同)

Rob*_*bbZ 6

以下是0xA3在答案中引用的代码.我不得不更改声明语句以允许它在Office 64bit中正常运行但我无法再在Office 32bit中进行测试.对于我的使用,我试图用时区信息创建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
Run Code Online (Sandbox Code Playgroud)

以下代码来自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
Run Code Online (Sandbox Code Playgroud)


chu*_*kko 6

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

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

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

它似乎也没有提供一种可靠的方法来获得时区的3个字母缩写(Excel 2013支持格式()中的zzz - 未经测试).

编辑 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
Run Code Online (Sandbox Code Playgroud)

有两种方法可以实现抵消:

  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中设置年份.


Jul*_*ess 5

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

超级简单,超级保存,只需几行代码

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

作为源/目标时区,您可以使用可以在注册表中找到的所有时区: HKEY_LOCAL_MACHINE / SOFTWARE / Microsoft / Windows NT / CurrentVersion /时区/

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
Run Code Online (Sandbox Code Playgroud)

PS:如果您经常需要使用该方法,建议您在子/函数之外声明Outlook对象。一次创建并保持其活动状态。


Pat*_*rez 5

基于 Julian Hess 对使用 Outlook 功能的极好建议,我构建了这个模块,它适用于 Access 和 Excel。

Option Explicit

'mTimeZones by Patrick Honorez --- www.idevlop.com
'with the precious help of Julian Hess /sf/answers/3185749871/
'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
Run Code Online (Sandbox Code Playgroud)

  • 您的 GetOutLook 函数可以只使用 Set oOutl = CreateObject("Outlook.Application")` - 一次只能打开一个 Outlook 实例,因此在这种情况下,如果对象已打开,则 `CreateObject` 会获取该对象... .现在只需找到文件来支持我的主张。 (2认同)