获取信息 Timezone 在 VBA /Excel/

我想确定时间偏移 GMT / UTC /包括夏季时间/ 对于特定日期的不同国家 VBA. 有任何想法吗?

EDIT /从自己回答/:

谢 0xA3. 我很快重读了连接的页面。 我想你只能下车 GMT 对于它的工作原理 windows:


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?
已邀请:

詹大官人

赞同来自:

VBA 没有为此提供函数,但 Windows API 制作。 幸运的是,您还可以使用所有这些功能 VBA. 此页面描述了如何做到:
http://www.cpearson.com/excel/ ... .aspx

编辑:添加代码

为了后代,我从页面添加了完整代码 Guru Chip, 可用于32位 Office VBA. /修改 64-bit

/


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

三叔

赞同来自:

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

称呼 GetTimeZoneInformation// 返回信息 DST 关于

当前时间

, 但转变的日期可以是另一个设置的时期 DST - 因此,八月的1月份日期的转换将申请当前的抵消,从而给予日期 GMT 在 1 小小的时间比正确的 / SystemTimeToTzSpecificLocalTime

,

它似乎更好 - 尚未验证/

这同样适用于来自另一年的日期 - 当规则时 DST 可能是不同的。

GetTimeZoneInformationForYear

必须处理不同年份的变化。 我完成了一个示例代码,一旦完成。

这也看来 Windows 不提供可靠的方法来获得3个字母的缩写 timezone /Excel 2013 支持 zzz 在 Format//- 他被测试了/.

Edit 16.04.2015

: IntArrayToString// 删除,因为它已经存在 modWorksheetFunctions.bas, 这提到了以下文章下面 cpearson.com.

添加代码进行转换使用 timezone, 在日期转换时活跃 /这个问题没有考虑在上面 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 实现偏移的方法:

删除本地日期和转换日期。 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.

江南孤鹜

赞同来自:

这是指答案的代码 0xA3. 我不得不改变运营商 declare, 所以他工作了 Office 64bit, 但我不能再试一次他 Office 32bit. 对于我的用途,我试图创造 ISO 8601 日期与信息 timezone. 因此,我使用此功能。


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/ ... .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

快网

赞同来自:

我建议创建一个对象 Outlook 并使用内置方法

ConvertTime

:
https://msdn.microsoft.com/VBA ... tlook
超级简单,超级保存,只有几行代码

此示例正在转换 inputTime 的 UTC 在 CET:

作为源的时钟区域/目的地您可以使用您可以找到的所有时区
在该部分的注册表中:

HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/


Dim OutlookApp As Object
Dim TZones As TimeZones
Dim convertedTime As Date
Dim inputTime As Date
Dim sourceTZ As TimeZone
Dim destTZ As TimeZone
Dim secNum as Integer
Set OutlookApp = CreateObject/"Outlook.Application"/
Set TZones = OutlookApp.TimeZones
Set sourceTZ = TZones.Item/"UTC"/
Set destTZ = TZones.Item/"W. Europe Standard Time"/
inputTime = Now
Debug.Print "GMT: " & inputTime
'' the outlook rounds the seconds to the nearest minute
'' thus, we store the seconds, convert the truncated time and add them later
secNum = Second/inputTime/
inputTime = DateAdd/"s",-secNum, inputTime/
convertedTime = TZones.ConvertTime/inputTime, sourceTZ, destTZ/
convertedTime = DateAdd/"s",secNum, convertedTime/
Debug.Print "CET: " & convertedTime


PS: 如果您经常使用此方法,我建议声明一个对象 Outlook 外部 sub/function., 创建一次并保持活力。

董宝中

赞同来自:

基于朱利安Hess的优秀推荐使用机会 Outlook, 我建立了适用的模块 Access 和 Excel.


Option Explicit

'mTimeZones by Patrick Honorez --- www.idevlop.com
'with the precious help of Julian Hess [url=https://stackoverflow.com/a/45510712/78522]https://stackoverflow.com/a/45510712/78522[/url]
'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

三叔

赞同来自:

帕特里克Onoreza的一个精彩决定的几个技巧。

一些错误检查和几个额外的测试。 :-/


Option Explicit

'mTimeZones by Patrick Honorez --- www.idevlop.com
'with the precious help of Julian Hess [url=https://stackoverflow.com/a/45510712/78522]https://stackoverflow.com/a/45510712/78522[/url]
'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

郭文康

赞同来自:

尽管 Outlook 可以提供 /慢/ 标签有关时区的信息,您可以直接去,但很多代码需要很多解决方案 - 远远超过上面的东西,并且在这里发布太多,部分原因是某些信息是本地化的。

我项目的主要功能
https://github.com/GustavBrock ... ndows
在下之中:


' 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


该项目由两篇文章提供支持:

https://www.experts-exchange.c ... .html
https://www.experts-exchange.c ... .html
包括用于访问的演示版和 Excel.

https://i.stack.imgur.com/0sy5Q.png

要回复问题请先登录注册