Uzyskaj informacje o strefie czasowej w VBA (Excel)

VBA nie oferuje funkcji do tego, ale Windows API tak. Na szczęście możesz używać wszystkich tych funkcji również z VBA. Ta strona opisuje, jak to zrobić:


strefy czasowe & amp; czas letni

http://www.cpearson.com/excel/ ... .aspx

Edytuj: Dodano kod

Ze względu na potomność dodałem cały kod ze strony Guru Chip, którego można używać w 32-bitowym Office VBA. (modyfikacja 64-bit

tutaj
https://stackoverflow.com/a/20489651/8112776
)

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 TypePrivate 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 TypePublic 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 LongPrivate 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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 FunctionFunction 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

Zwróć uwagę na małą pułapkę w rozwiązaniu.
Wywołanie GetTimeZoneInformation () zwraca informacje o czasie letnim

Obecny czas

Ale transformowana data może być z okresu z innym ustawieniem DST - więc konwersja daty styczeń w sierpniu zastosuje obecne przesunięcie, dając w ten sposób datę GMT przez 1 godzinę mniejszą niż prawidłowa (systemtimetotzpecificlocaltime

,

wydaje się lepiej pasować - jeszcze nie testowane)
To samo dotyczy dnia z innego roku - gdy reguły DST mogłyby być inne.

GetTimeZoneInformationForYear

Musi obsługiwać zmiany w różnych latach. Umieściłem tutaj przykładowy kod, jak tylko skończę.
Wydaje się również, że system Windows nie zapewnia niezawodnego sposobu na uzyskanie 3-literowego skrótu strefy czasowej (Excel 2013 obsługuje zzz w formacie () - nie testowano).

Edit 16.04.2015
: Usunięto IntArrayToString (), ponieważ jest już obecny w modWorksheetFunctions.bas, do którego odwołują się poniższe artykuły na cpearson.com.
Dodawanie kodu do konwersji za pomocą strefy czasu, aktywne w momencie konwersji daty (ten problem nie jest wyświetlany na CPearson.com). Przetwarzanie błędów nie jest uwzględniane dla zwięzłości.

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 TypePrivate Declare Function GetTimeZoneInformationForYear Lib "kernel32" ( _

 wYear As Integer, _

 lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _

 lpTimeZoneInformation As TIME_ZONE_INFORMATION _) As LongPrivate Declare Function GetDynamicTimeZoneInformation Lib "kernel32" ( _

 pTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION _) As LongPrivate Declare Function TzSpecificLocalTimeToSystemTimeEx Lib "kernel32" ( _

 lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _

 lpLocalTime As SYSTEMTIME, _

 lpUniversalTime As SYSTEMTIME _) As LongFunction 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

Istnieją 2 sposoby osiągnięcia nastawienia:

• Usuń lokalną datę i transformowaną datę GMT:

  offset = (lpDateLocal - lpDateGmt)*24*60

• pobierz TZI na określony rok i oblicz:

  dst = GetTimeZoneInformationForYear(Year(lpDateLocal), lpDTZI, lpTZI)offset = lpTZI.Bias + IIf(lpDateLocal >= SystemTimeToSerialTime(lpTZI.DaylightDate) And lpDateLocal < SystemTimeToSerialTime(lpTZI.StandardDate), lpTZI.DaylightBias, lpTZI.StandardBias)

UWAGA: Z jakiegoś powodu wartość wypełniona w LPTZI tutaj nie zawiera informacji o roku, więc musisz ustawić rok w LPTZI.DEACTIONDATE i LPTZI.Standarddate.

Oto kod, który odnosi się do 0xA3. Musiałem zmienić oświadczenia, aby działał poprawnie w biurze 64bit, ale nie mogłem ponownie przetestować go w biurze 32bit. Do mojego wykorzystania próbowałem utworzyć datę ISO 8601 z informacjami o strefach czasowych. Dlatego użyłem tego funkcji.

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 IfEnd Function

Poniższy kod pochodzi z

http://www.cpearson.com/excel/ ... .aspx
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 TypePrivate 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 TypePublic 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 DateIf 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 = GMTEnd 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 DateIf 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 = LocalTimeEnd FunctionFunction 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 WithEnd FunctionFunction 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 IfLocalOffsetFromGMT = TBiasEnd FunctionFunction 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

Polecam tworzenie obiektu Outlook i użyj metody wbudowanej

ConvertTime

:

https://msdn.microsoft.com/vba ... look.
https://msdn.microsoft.com/VBA ... tlook
Super Easy, Super Zapisz i zaledwie kilka linii kodu

Ten przykład konwertuje wprowadzenie z UTC do CET:
Jako strefa czasowa źródła/miejsca docelowego możesz użyć wszystkich stref czasowych, które można znaleźć
w swoim rejestrze pod:

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: Jeśli często musisz użyć tej metody, zalecam zadeklarować obiekt programu Outlook na zewnątrz sub/funkcji. Utwórz go raz i zapisz go przy życiu.

W oparciu o wielką rekomendację Julian Hess używać funkcji Outlook, zbudowałem ten moduł, który współpracuje z dostępem i programem 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 AccessPrivate 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 FunctionFunction 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 FunctionSub 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 SubSub test_DumpTZs()

 Dim TZ As Object: For Each TZ In GetOutlookTimeZones()

 Debug.Print "TZ:", TZ.Id, TZ.Name

 Next TZ

End Sub

Kilka sztuczek w cudownej decyzji Patricka Onoreza.
Niektóre kontrole błędów i kilka dodatkowych testów. :-)

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 useabilityPrivate oOutl As Object 'keep Outlook reference active, to save time n recurring callsPrivate 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 FunctionPublic 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 SubPublic 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

Podczas gdy Outlook może dostarczyć (powolny) etykietę do informacji o strefach czasowych, możesz jechać bezpośrednio, ale w ogólnym rozwiązaniu wymaga dużo kodu - znacznie więcej niż wskazany powyżej, i zbyt wiele do opublikowania tutaj, częściowo dlatego, że niektóre informacje są zlokalizowane .
Główna funkcja mojego projektu

VBA.Timezone-Windows
https://github.com/GustavBrock ... ndows
Leży poniżej:
<pre class="lang-vb prettyprint-override">

' 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

Projekt wspierają dwa artykuły:
Strefy czasowe, okna i VBA część 1
https://www.experts-exchange.c ... .html
Strefy czasowe, Windows i Microsoft Office Part 2
https://www.experts-exchange.c ... .html
W tym wersje demonstracyjne do dostępu i programu Excel.
https://i.stack.imgur.com/0sy5Q.png