我想确定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中这样做吗?
答案 0 :(得分:10)
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 :(得分: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
以下代码来自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
答案 2 :(得分:6)
请注意解决方案中的小陷阱。
GetTimeZoneInformation()调用返回有关当前时间的DST信息,但转换后的日期可能来自具有不同DST设置的时段 - 因此转换8月份的1月日期将应用当前的偏差,因此,GMT日期比正确的日期少1小时( SystemTimeToTzSpecificLocalTime 似乎更合适 - 尚未经过测试)
当日期来自另一年 - 当夏令时规则可能不同时,同样适用。 GetTimeZoneInformationForYear 应该处理不同年份的变化。完成后我会把代码示例放在这里。
Windows似乎也没有提供获得时区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
有两种方法可以实现抵消:
减去本地日期和转换后的gmt日期:
offset = (lpDateLocal - lpDateGmt)*24*60
获取特定年份的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中设置年份。
答案 3 :(得分:4)
我建议创建一个Outlook对象并使用内置方法 ConvertTime :https://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
PS:如果您经常使用该方法,我建议您在子/函数之外声明Outlook对象。创建一次并保持活着。
答案 4 :(得分:1)
基于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
'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 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)
Set destTZ = TZones.Item(TZto)
ConvertTime = TZones.ConvertTime(DT_SecondsStripped, 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
答案 5 :(得分:0)
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
答案 6 :(得分:0)
虽然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 :(得分:0)
以下是几个可能有用的函数,通过将 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 日。< /p>
CheckDST_UK1972:简化版。如果英国夏令时适用于指定日期,则返回 True,基于自 1972 年以来定义的 BST 系统;否则返回 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