在 VBA (Excel) 中获取时区信息
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/3120915/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Get Timezone Information in VBA (Excel)
提问by Marcel Menz
I would like to determine a time offset to GMT/UTC (including daylight saving time) for different countries at a specific date in VBA. Any ideas?
我想在 VBA 中的特定日期确定不同国家/地区的 GMT/UTC(包括夏令时)的时间偏移量。有任何想法吗?
EDIT (from self-answer):
编辑(来自自我回答):
Thank you 0xA3. I quickly read-over the linked page. I assume that you can only get the offset to GMT for the local where windows is running:
谢谢 0xA3。我快速阅读了链接页面。我假设您只能获得运行 Windows 的本地 GMT 的偏移量:
ConvertLocalToGMT
DaylightTime
GetLocalTimeFromGMT
LocalOffsetFromGMT
SystemTimeToVBTime
LocalOffsetFromGMT
In Java you can do the following:
在 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));
This means I can get the offset for different countries (timezones) and I thus can also get the actual time lets say in bucharest. Can I do this in VBA?
这意味着我可以获得不同国家(时区)的偏移量,因此我也可以获得实际时间,比如在布加勒斯特。我可以在 VBA 中做到这一点吗?
回答by Dirk Vollmar
VBA doesn't offer functions to do that, but the Windows API does. Luckily you can use all those functionality from VBA as well. This page describes how to do it: Time Zones & Daylight Savings Time
VBA 不提供执行此操作的函数,但 Windows API 提供。幸运的是,您也可以使用 VBA 中的所有这些功能。此页面描述了如何操作:时区和夏令时
Edit: Added Code
编辑:添加代码
For the posterity sake, I've added the complete code from Guru Chip's page, as usable in 32-bit Office VBA. (64-bit modification here)
为了后代,我添加了 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
回答by chukko
Please be aware of little trap in the solution.
请注意解决方案中的小陷阱。
The GetTimeZoneInformation() call returns DST info about the current time, but the converted date might be from the period with the different DST setting - thus converting January date in August would apply the current Bias, thus yielding the GMT date 1 hour less than the correct one (SystemTimeToTzSpecificLocalTimeseems to be a better fit - untested yet)
GetTimeZoneInformation() 调用返回有关当前时间的DST 信息,但转换后的日期可能来自具有不同 DST 设置的时期 - 因此在 8 月转换 1 月日期将应用当前偏差,从而产生比 GMT 日期少 1 小时的 GMT 日期正确的(SystemTimeToTzSpecificLocalTime似乎更合适 - 尚未测试)
The same applies when the date is from another year - when DST rules might have been different. GetTimeZoneInformationForYearshould handle changes in different years. I'll put a code sample here once completed.
当日期来自另一年时同样适用 - 当 DST 规则可能不同时。GetTimeZoneInformationForYear应该处理不同年份的变化。完成后我会在这里放一个代码示例。
It also seems Windows does not provide a reliable way to get 3 letter abbreviation of the timezone (Excel 2013 supports zzz in Format() - not tested).
Windows 似乎也没有提供一种可靠的方法来获取时区的 3 个字母缩写(Excel 2013 支持 Format() 中的 zzz - 未测试)。
Edit 16.04.2015: IntArrayToString() removed as it is already present in modWorksheetFunctions.bas referenced in below mentioned cpearson.com articles.
2015 年 4 月 16 日编辑:删除 IntArrayToString(),因为它已经存在于下面提到的 cpearson.com 文章中引用的 modWorksheetFunctions.bas 中。
Adding code to convert using timezone active at the time of the converted date (this issue is not addressed on cpearson.com). Error handling is not included for brevity.
添加代码以使用转换日期时活动的时区进行转换(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
There are 2 ways to achieve offset:
有两种方法可以实现偏移:
subtract local date and converted gmt date:
offset = (lpDateLocal - lpDateGmt)*24*60get TZI for specific year and calculate:
dst = GetTimeZoneInformationForYear(Year(lpDateLocal), lpDTZI, lpTZI) offset = lpTZI.Bias + IIf(lpDateLocal >= SystemTimeToSerialTime(lpTZI.DaylightDate) And lpDateLocal < SystemTimeToSerialTime(lpTZI.StandardDate), lpTZI.DaylightBias, lpTZI.StandardBias)
减去本地日期和转换后的 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)
Caveat: For some reason, values populated in lpTZI here do not contain the year information, so you need to set the year in lpTZI.DaylightDate and lpTZI.StandardDate.
警告:出于某种原因,此处 lpTZI 中填充的值不包含年份信息,因此您需要在 lpTZI.DaylightDate 和 lpTZI.StandardDate 中设置年份。
回答by RobbZ
Here is the code that is referenced in the answer by 0xA3. I had to change the declare statements to allow it run properly in Office 64bit but I haven't been able to test again in Office 32bit. For my use I was trying to create ISO 8601 dates with timezone information. So i used this function for that.
这是答案中 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
The code below came from http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx
下面的代码来自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
回答by Julian Hess
I recommend to create an Outlook object and use the in-built method ConvertTime: https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook
我建议创建一个 Outlook 对象并使用内置方法ConvertTime:https: //msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook
Super easy, super save and just a few lines of code
超级简单,超级保存,只需几行代码
This example converts the inputTime from UTC to CET:
As a source/destination time zone you can use all time zones you can find in your registry under: HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/
Dim OutlookApp As Object Dim TZones As TimeZones Dim convertedTime As Date Dim inputTime As Date Dim sourceTZ As TimeZone Dim destTZ As TimeZone Dim secNum as Integer Set OutlookApp = CreateObject("Outlook.Application") Set TZones = OutlookApp.TimeZones Set sourceTZ = TZones.Item("UTC") Set destTZ = TZones.Item("W. Europe Standard Time") inputTime = Now Debug.Print "GMT: " & inputTime '' the outlook rounds the seconds to the nearest minute '' thus, we store the seconds, convert the truncated time and add them later secNum = Second(inputTime) inputTime = DateAdd("s",-secNum, inputTime) convertedTime = TZones.ConvertTime(inputTime, sourceTZ, destTZ) convertedTime = DateAdd("s",secNum, convertedTime) Debug.Print "CET: " & convertedTime
此示例将 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: if you often have to use the method, I recommend to declare the Outlook object outside of your sub/function. Create it once and keep it alive.
PS:如果你经常不得不使用该方法,我建议在你的子/函数之外声明 Outlook 对象。创建一次并保持活力。
回答by Patrick Honorez
Based on Julian Hess excellent recommendation to use Outlook capabilities, I have build this module, which works with Access and Excel.
基于 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 oOutlTimeZones As Object 'keep Outlook reference active, to save time n recurring calls
Private Function GetOutlookTimeZones() As Boolean
'get or start an Outlook instance and assign it to oOutl, then put the .TimeZones property value in oOutlTimeZones
'returns True if successful, False otherwise
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
GetOutlookTimeZones = Not (oOutlTimeZones 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 sourceTZ As Object
Dim destTZ As Object
Dim seconds As Single
Dim DT_SecondsStripped As Date
If GetOutlookTimeZones 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
Sub test_ConvertTime()
Dim t As Date
Dim tz As Object
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")
For Each tz in oOutlTimeZones
Debug.Print "TZ:", tz.Id, tz.Name
Next tz
End Sub
回答by Murrah
A few tweaks to Patrick Honorez's great solution.
对 Patrick Honorez 的出色解决方案进行了一些调整。
A bit of error checking and some extra tests. :-)
一些错误检查和一些额外的测试。:-)
Option Explicit
'mTimeZones by Patrick Honorez --- www.idevlop.com
'with the precious help of Julian Hess https://stackoverflow.com/a/45510712/78522
'You can reuse but please let all the original comments including this one.
'This modules uses late binding and therefore should not require an explicit reference to Outlook,
'however Outlook must be properly installed and configured on the machine using this module
'Module works with Excel and Access
'Murray Hopkins: a few tweaks for better useability
Private oOutl As Object 'keep Outlook reference active, to save time n recurring calls
Private Function GetOutlook() As Boolean
'get or start an Outlook instance and assign it to oOutl
'returns True if successful, False otherwise
If oOutl Is Nothing Then
'Debug.Print "~"
On Error Resume Next
Err.Clear
Set oOutl = GetObject(, "Outlook.Application")
If Err.Number Then
Err.Clear
Set oOutl = CreateObject("Outlook.Application")
End If
End If
GetOutlook = Not (oOutl Is Nothing)
On Error GoTo 0
End Function
Public Function ConvertTime(DT As Date, Optional TZfrom As String = "UTC", Optional TZto As String = "") As Date
'convert datetime with hour from Source time zone to Target time zone
'valid Source & Target time zones can be found in your registry under: HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/
'this version using Outlook, properly handles Dailight Saving Times, including for past and future dates
'it includes a fix for the fact that ConvertTime seems to strip the seconds
'krammy85 2019-01-25 Edit: Outlook rounds minutes when it strips seconds, so modified code to strip seconds (without rounding) prior to running Outlook's ConvertTime.
Dim TZones As Object
Dim sourceTZ As Object
Dim destTZ As Object
Dim seconds As Single
Dim DT_SecondsStripped As Date
' If the conversion fails it will return the time unchanged
' You could change this if you want
Dim convertedTime As Date
convertedTime = DT
If GetOutlook Then
'fix for ConvertTime stripping the seconds
seconds = Second(DT) / 86400 'save the seconds as DateTime (86400 = 24*60*60)
DT_SecondsStripped = DT - seconds
Set TZones = oOutl.TimeZones
Set sourceTZ = TZones.item(TZfrom)
' Default to the timezone currently on this system if not passed in
If TZto = "" Then TZto = oOutl.TimeZones.CurrentTimeZone
Set destTZ = TZones.item(TZto)
If validTimeZoneName(TZfrom, sourceTZ) And validTimeZoneName(TZto, destTZ) Then
convertedTime = TZones.ConvertTime(DT_SecondsStripped, sourceTZ, destTZ) + seconds 'add the stripped seconds
End If
Else
Call MsgBox("Could not find MS-Outlook on this computer." & vbCrLf & "It mut be installed for this app to work", vbCritical, "ERROR")
End
End If
ConvertTime = convertedTime
End Function
' Make sure the time zone name returned an entry from the Registry
Private Function validTimeZoneName(tzName, TZ) As Boolean
Dim nameIsValid As Boolean
nameIsValid = True
If TZ Is Nothing Then
Call MsgBox("The timezone name of '" & tzName & "' is not valid." & vbCrLf & "Please correct it and try again.", vbCritical, "ERROR")
' This might be too harsh. ie ends the app.
' End
nameIsValid = False
End If
validTimeZoneName = nameIsValid
End Function
' Tests
Public Sub test_ConvertTime()
Dim t As Date, TZ As String
t = #8/23/2019 6:15:05 AM#
Debug.Print "System default", t, ConvertTime(t), Format(t - ConvertTime(t), "h:nn")
Call test_DoConvertTime("UTC", "AUS Eastern Standard Time")
Call test_DoConvertTime("UTC", "AUS Central Standard Time")
Call test_DoConvertTime("UTC", "E. Australia Standard Time")
Call test_DoConvertTime("UTC", "Aus Central W. Standard Time")
Call test_DoConvertTime("UTC", "W. Australia Standard Time")
Call test_DoConvertTime("W. Australia Standard Time", "AUS Eastern Standard Time")
' Throw error
Call test_DoConvertTime("UTC", "Mars Polar Time")
End
End Sub
Public Sub test_DoConvertTime(ByVal fromTZ As String, ByVal toTZ As String)
Dim t As Date, TZ As String, resDate As Date, msg
t = #8/23/2019 6:15:05 AM#
resDate = ConvertTime(t, fromTZ, toTZ)
msg = fromTZ & " to " & toTZ
Debug.Print msg, t, resDate, Format(t - resDate, "h:nn")
End Sub

