2010-06-25 120 views
12

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

EDIT(from self-answer):

谢谢0xA3。我快速翻阅链接的页面。我假设你只能得到日光节约的地方在那里窗口运行:

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中做到这一点吗?

回答

9

VBA不提供这样做的功能,但Windows API确实可以。幸运的是,您也可以使用VBA中的所有功能。此页面介绍如何做到这一点:

Time Zones And Daylight Savings Time

+2

+1但是,我建议您在此粘贴(或书写,如果您认为版权问题可能出现)相关的代码。如果源网站发生故障,它将留在这里以供将来参考 – 2010-06-25 21:53:51

+0

@belisarius:好点,希望我或其他人有时间这样做以后;-) – 2010-06-25 21:55:56

+0

我添加了代码作为对问题的附加答案。尽管我必须对Declare语句进行更改才能使其在Office 64位上正常工作。 – RobbZ 2013-12-10 08:32:20

5

这里是由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 

下面的代码从http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx

Option Explicit 
Option Compare Text 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' modTimeZones 
' By Chip Pearson, [email protected], 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 
5

来请注意在解决小陷阱。

的GetTimeZoneInformation()调用返回有关当前时间 DST的信息,但转换后的日期可能是从不同的DST设定的期限 - 因此在八月转换一月日期将应用当前的偏差,从而产生了GMT日期比正确的少1小时(SystemTimeToTzSpecificLocalTime似乎是更好的选择 - 但未经测试)

这同样适用于当日期为一年 - 当DST规则可能有所不同。 GetTimeZoneInformationForYear应该处理不同年份的变化。一旦完成,我会在这里放置一个代码示例。

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

编辑2015年4月16日: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。

+1

值得注意的是:伦敦和纽约每年都有不同的夏令时模式,每年有7天的时间。如果您要从这两个位置的应用程序导入时间戳数据,您*会*在此期间遇到此陷阱。 – 2015-05-20 10:56:16

+0

最让我惊讶的是,没有人会用VBA报告同样的问题,甚至是伟大的cpearson脚本不处理(甚至在你自己的时区处理6个月的数据,你必须绊倒这一点)。 – chukko 2015-05-20 16:44:21

2

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

超级简单,超级节约和代码只需要几行

这个例子转换inputTime从UTC到CET:

作为源/目的地时区,您可以使用所有时区,在您的注册表中可以找到 : HKEY_LOCAL_MACHINE/SOFTWARE /微软/的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 

PS:如果你经常使用的方法,我建议来声明子/功能之外Outlook对象。创建一次并保持活力。

+0

这看起来很有趣,但你如何提供源时区和目标时区?你能否提供一个小样本? Thx – 2017-08-21 15:13:02

+0

thx。但是提供的代码似乎没有编译。对于2d和3d参数,ConvertTime需要一个'TimeZone'对象,而不是一个字符串。 – 2017-08-23 07:44:38

+1

@PatrickHonorez请刷新页面以查看正确的代码 – 2017-08-23 07:49:16

0

基于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 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 

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 
'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 
    Dim TZones As Object 
    Dim sourceTZ As Object 
    Dim destTZ As Object 
    Dim seconds As Single 
    If GetOutlook Then 
     'fix for ConvertTime stripping the seconds 
     seconds = Second(DT)/86400 'save the seconds as DateTime (86400 = 24*60*60) 
     Set TZones = oOutl.TimeZones 
     Set sourceTZ = TZones.Item(TZfrom) 
     Set destTZ = TZones.Item(TZto) 
     ConvertTime = TZones.ConvertTime(DT, sourceTZ, destTZ) + seconds 'add the stripped seconds 
    End If 
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") 
End Sub