Получить информацию о временной зоне в VBA (Excel)

Question

Я хотел бы определить временное смещение к GMT/UTC (включая летнее время) для разных стран в определенную дату в VBA. Есть идеи?

EDIT (от самостоятельного ответа):

Спасибо 0xA3. Я быстро прочитал связанную страницу. Я предполагаю, что вы только можете получить часовой пояс для локального, где окна работает:

ConvertLocalToGMT  
DaylightTime 
GetLocalTimeFromGMT   
LocalOffsetFromGMT 
SystemTimeToVBTime 
LocalOffsetFromGMT 

В Java вы можете сделать следующее:

TimeZone bucharestTimeZone = TimeZone.getTimeZone("Europe/Bucharest"); 
    bucharestTimeZone.getOffset(new Date().getTime()); 

Calendar nowInBucharest = Calendar.getInstance(TimeZone.getTimeZone("Europe/Bucharest")); 
    nowInBucharest.setTime(new Date()); 
    System.out.println("Bucharest: " + nowInBucharest.get(Calendar.HOUR) + ":" + nowInBucharest.get(Calendar.MINUTE)); 

Это означает, что я могу получить смещение для различных страны (часовые пояса), и я, таким образом, также могу получить фактическое время, скажем, в bucharest. Могу ли я сделать это в VBA?

Answer 1

VBA не предлагает функции для этого, но это делает Windows API. К счастью, вы можете использовать все эти функции и из VBA. Эта страница описывает, как это сделать:

Time Zones And Daylight Savings Time

Answer 2

Вот код, который упоминается в ответе по 0xA3. Я должен был изменить инструкции declare, чтобы он мог корректно работать в Office 64bit, но я не смог снова протестировать Office 32bit. Для моего использования я пытался создать даты ISO 8601 с информацией о часовом поясе. Поэтому я использовал эту функцию для этого.

Public Function ConvertToIsoTime(myDate As Date, includeTimezone As Boolean) As String 

    If Not includeTimezone Then 
     ConvertToIsoTime = Format(myDate, "yyyy-mm-ddThh:mm:ss") 
    Else 
     Dim minOffsetLong As Long 
     Dim hourOffset As Integer 
     Dim minOffset As Integer 
     Dim formatStr As String 
     Dim hourOffsetStr As String 

     minOffsetLong = LocalOffsetFromGMT(False, True) * -1 
     hourOffset = minOffsetLong \ 60 
     minOffset = minOffsetLong Mod 60 

     If hourOffset >= 0 Then 
      hourOffsetStr = "+" + CStr(Format(hourOffset, "00")) 
     Else 
      hourOffsetStr = CStr(Format(hourOffset, "00")) 
     End If 

     formatStr = "yyyy-mm-ddThh:mm:ss" + hourOffsetStr + ":" + CStr(Format(minOffset, "00")) 
     ConvertToIsoTime = Format(myDate, formatStr) 


    End If 

End Function 

Код доносился из http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx

Option Explicit 
Option Compare Text 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' modTimeZones 
' By Chip Pearson, chip@cpearson.com, www.cpearson.com 
' Date: 2-April-2008 
' Page Specific URL: www.cpearson.com/Excel/TimeZoneAndDaylightTime.aspx 
' 
' This module contains functions related to time zones and GMT times. 
' Terms: 
' ------------------------- 
' GMT = Greenwich Mean Time. Many applications use the term 
'  UTC (Universal Coordinated Time). GMT and UTC are 
'  interchangable in meaning, 
' Local Time = The local "wall clock" time of day, that time that 
'  you would set a clock to. 
' DST = Daylight Savings Time 

' Functions In This Module: 
' ------------------------- 
'  ConvertLocalToGMT 
'   Converts a local time to GMT. Optionally adjusts for DST. 
'  DaylightTime 
'   Returns a value indicating (1) DST is in effect, (2) DST is 
'   not in effect, or (3) Windows cannot determine whether DST is 
'   in effect. 
'  GetLocalTimeFromGMT 
'   Converts a GMT Time to a Local Time, optionally adjusting for DST. 
'  LocalOffsetFromGMT 
'   Returns the number of hours or minutes between the local time and GMT, 
'   optionally adjusting for DST. 
'  SystemTimeToVBTime 
'   Converts a SYSTEMTIME structure to a valid VB/VBA date. 
'  LocalOffsetFromGMT 
'   Returns the number of minutes or hours that are to be added to 
'   the local time to get GMT. Optionally adjusts for DST. 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 


''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' Required Types 
''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Private Type SYSTEMTIME 
    wYear As Integer 
    wMonth As Integer 
    wDayOfWeek As Integer 
    wDay As Integer 
    wHour As Integer 
    wMinute As Integer 
    wSecond As Integer 
    wMilliseconds As Integer 
End Type 

Private Type TIME_ZONE_INFORMATION 
    Bias As Long 
    StandardName(0 To 31) As Integer 
    StandardDate As SYSTEMTIME 
    StandardBias As Long 
    DaylightName(0 To 31) As Integer 
    DaylightDate As SYSTEMTIME 
    DaylightBias As Long 
End Type 

Public Enum TIME_ZONE 
    TIME_ZONE_ID_INVALID = 0 
    TIME_ZONE_STANDARD = 1 
    TIME_ZONE_DAYLIGHT = 2 
End Enum 

''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' Required Windows API Declares 
''''''''''''''''''''''''''''''''''''''''''''''''''''' 
#If VBA7 Then 
    Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" _ 
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long 
#Else 
    Private Declare Function GetTimeZoneInformation Lib "kernel32" _ 
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long 
#End If 

#If VBA7 Then 
    Private Declare PtrSafe Sub GetSystemTime Lib "kernel32" _ 
     (lpSystemTime As SYSTEMTIME) 
#Else 
    Private Declare Sub GetSystemTime Lib "kernel32" _ 
     (lpSystemTime As SYSTEMTIME) 
#End If 




Function ConvertLocalToGMT(Optional LocalTime As Date, _ 
    Optional AdjustForDST As Boolean = False) As Date 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' ConvertLocalToGMT 
' This converts a local time to GMT. If LocalTime is present, that local 
' time is converted to GMT. If LocalTime is omitted, the current time is 
' converted from local to GMT. If AdjustForDST is Fasle, no adjustments 
' are made to accomodate DST. If AdjustForDST is True, and DST is 
' in effect, the time is adjusted for DST by adding 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Dim T As Date 
Dim TZI As TIME_ZONE_INFORMATION 
Dim DST As TIME_ZONE 
Dim GMT As Date 

If LocalTime <= 0 Then 
    T = Now 
Else 
    T = LocalTime 
End If 
DST = GetTimeZoneInformation(TZI) 
If AdjustForDST = True Then 
    GMT = T + TimeSerial(0, TZI.Bias, 0) + _ 
      IIf(DST = TIME_ZONE_DAYLIGHT, TimeSerial(0, TZI.DaylightBias, 0), 0) 
Else 
    GMT = T + TimeSerial(0, TZI.Bias, 0) 
End If 
ConvertLocalToGMT = GMT 

End Function 


Function GetLocalTimeFromGMT(Optional StartTime As Date) As Date 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' GetLocalTimeFromGMT 
' This returns the Local Time from a GMT time. If StartDate is present and 
' greater than 0, it is assumed to be the GMT from which we will calculate 
' Local Time. If StartTime is 0 or omitted, it is assumed to be the GMT 
' local time. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Dim GMT As Date 
Dim TZI As TIME_ZONE_INFORMATION 
Dim DST As TIME_ZONE 
Dim LocalTime As Date 

If StartTime <= 0 Then 
    GMT = Now 
Else 
    GMT = StartTime 
End If 
DST = GetTimeZoneInformation(TZI) 
LocalTime = GMT - TimeSerial(0, TZI.Bias, 0) + _ 
     IIf(DST = TIME_ZONE_DAYLIGHT, TimeSerial(1, 0, 0), 0) 
GetLocalTimeFromGMT = LocalTime 

End Function 

Function SystemTimeToVBTime(SysTime As SYSTEMTIME) As Date 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' SystemTimeToVBTime 
' This converts a SYSTEMTIME structure to a VB/VBA date value. 
' It assumes SysTime is valid -- no error checking is done. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
With SysTime 
    SystemTimeToVBTime = DateSerial(.wYear, .wMonth, .wDay) + _ 
      TimeSerial(.wHour, .wMinute, .wSecond) 
End With 

End Function 

Function LocalOffsetFromGMT(Optional AsHours As Boolean = False, _ 
    Optional AdjustForDST As Boolean = False) As Long 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' LocalOffsetFromGMT 
' This returns the amount of time in minutes (if AsHours is omitted or 
' false) or hours (if AsHours is True) that should be added to the 
' local time to get GMT. If AdjustForDST is missing or false, 
' the unmodified difference is returned. (e.g., Kansas City to London 
' is 6 hours normally, 5 hours during DST. If AdjustForDST is False, 
' the resultif 6 hours. If AdjustForDST is True, the result is 5 hours 
' if DST is in effect.) 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Dim TBias As Long 
Dim TZI As TIME_ZONE_INFORMATION 
Dim DST As TIME_ZONE 
DST = GetTimeZoneInformation(TZI) 

If DST = TIME_ZONE_DAYLIGHT Then 
    If AdjustForDST = True Then 
     TBias = TZI.Bias + TZI.DaylightBias 
    Else 
     TBias = TZI.Bias 
    End If 
Else 
    TBias = TZI.Bias 
End If 
If AsHours = True Then 
    TBias = TBias/60 
End If 

LocalOffsetFromGMT = TBias 

End Function 

Function DaylightTime() As TIME_ZONE 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' DaylightTime 
' Returns a value indicating whether the current date is 
' in Daylight Time, Standard Time, or that Windows cannot 
' deterimine the time status. The result is a member or 
' the TIME_ZONE enum. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Dim TZI As TIME_ZONE_INFORMATION 
Dim DST As TIME_ZONE 
DST = GetTimeZoneInformation(TZI) 
DaylightTime = DST 
End Function 

Answer 3

Обратите внимание на небольшой ловушке в растворе.

Вызов GetTimeZoneInformation() возвращает DST информацию о текущего времени, но преобразованное дата может быть в период с различной настройкой DST - таким образом, преобразование даты января в августе будет применять ток смещения, таким образом, дающую GMT дата 1 час меньше, чем один правильный (SystemTimeToTzSpecificLocalTime, кажется, лучше подходит - не тестировалось пока)

То же самое относится, когда дата другого года - когда правила перехода на летнее время, возможно, были различны. GetTimeZoneInformationForYear должен обрабатывать изменения в разные годы. После этого я выложу пример кода.

Также кажется, что Windows не обеспечивает надежный способ получить 3-х аббревиатуру от часовой пояс (Excel 2013 поддерживает zzz в формате() - не тестируется).

Редактировать 16.04.2015: IntArrayToString() удален, поскольку он уже присутствует в modWorksheetFunctions.bas, на который ссылаются в следующих статьях cpearson.com.

Добавление кода для преобразования с использованием часового пояса, действующего на момент преобразования (этот вопрос не рассматривается на cpearson.com). Обработка ошибок не включена для краткости.

Private Type DYNAMIC_TIME_ZONE_INFORMATION_VB 
    Bias As Long 
    StandardName As String 
    StandardDate As Date 
    StandardBias As Long 
    DaylightName As String 
    DaylightDate As Date 
    DaylightBias As Long 
    TimeZoneKeyName As String 
    DynamicDaylightTimeDisabled As Long 
End Type 

Private Declare Function GetTimeZoneInformationForYear Lib "kernel32" (_ 
    wYear As Integer, _ 
    lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _ 
    lpTimeZoneInformation As TIME_ZONE_INFORMATION _ 
) As Long 

Private Declare Function GetDynamicTimeZoneInformation Lib "kernel32" (_ 
    pTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION _ 
) As Long 

Private Declare Function TzSpecificLocalTimeToSystemTimeEx Lib "kernel32" (_ 
    lpDynamicTimeZoneInformation As DYNAMIC_TIME_ZONE_INFORMATION, _ 
    lpLocalTime As SYSTEMTIME, _ 
    lpUniversalTime As SYSTEMTIME _ 
) As Long 

Function LocalSerialTimeToGmt(lpDateLocal As Date) As Date 
    Dim retval As Boolean, lpDateGmt As Date, lpSystemTimeLocal As SYSTEMTIME, lpSystemTimeGmt As SYSTEMTIME 
    Dim lpDTZI As DYNAMIC_TIME_ZONE_INFORMATION 

    retval = SerialTimeToSystemTime(lpDateLocal, lpSystemTimeLocal) 
    retval = GetDynamicTimeZoneInformation(lpDTZI) 
    retval = TzSpecificLocalTimeToSystemTimeEx(lpDTZI, lpSystemTimeLocal, lpSystemTimeGmt) 
    lpDateGmt = SystemTimeToSerialTime(lpSystemTimeGmt) 
    LocalSerialTimeToGmt = lpDateGmt 
End Function 

Есть 2 способа для достижения смещения:

1. вычитать местные дата и превращали GMT Дата:

   offset = (lpDateLocal - lpDateGmt)*24*60

2. получить ТЗИ за определенный год и рассчитать:

   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.

Answer 4

Я рекомендую создать объект Outlook, и использовать встроенный метод ConvertTime: https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

Супер легкий, супер сохранить и всего несколько строк кода

Этот пример преобразует inputTime от UTC до CET:

В качестве часового пояса источника/назначения вы можете использовать все часовой пояс: в вашем регистре: HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows NT/CurrentVersion/часовых поясов/

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

PS: если вам часто приходится использовать метод, я рекомендую, чтобы объявить объект Outlook, за пределами вашего суб/функции , Создайте его один раз и сохраните его.

Answer 5

Основываясь на замечательной рекомендации Юлиана Хесса по использованию возможностей Outlook, я создал этот модуль, который работает с Access и Excel.

Option Explicit 

'mTimeZones by Patrick Honorez --- www.idevlop.com 
'with the precious help of Julian Hess https://stackoverflow.com/a/45510712/78522 
'You can reuse but please let all the original comments including this one. 

'This modules uses late binding and therefore should not require an explicit reference to Outlook, 
'however Outlook must be properly installed and configured on the machine using this module 
'Module works with Excel and Access 

Private oOutl As Object 'keep Outlook reference active, to save time n recurring calls 

Private Function GetOutlook() As Boolean 
'get or start an Outlook instance and assign it to oOutl 
'returns True if successful, False otherwise 
    If oOutl Is Nothing Then 
     Debug.Print "~" 
     On Error Resume Next 
     Err.Clear 
     Set oOutl = GetObject(, "Outlook.Application") 
     If Err.Number Then 
      Err.Clear 
      Set oOutl = CreateObject("Outlook.Application") 
     End If 
    End If 
    GetOutlook = Not (oOutl Is Nothing) 
    On Error GoTo 0 
End Function 

Function ConvertTime(DT As Date, Optional TZfrom As String = "Central Standard Time", _ 
           Optional TZto As String = "W. Europe Standard Time") As Date 
'convert datetime with hour from Source time zone to Target time zone 
'this version using Outlook, properly handles Dailight Saving Times, including for past and future dates 
'it includes a fix for the fact that ConvertTime seems to strip the seconds 
    Dim TZones As Object 
    Dim sourceTZ As Object 
    Dim destTZ As Object 
    Dim seconds As Single 
    If GetOutlook Then 
     'fix for ConvertTime stripping the seconds 
     seconds = Second(DT)/86400 'save the seconds as DateTime (86400 = 24*60*60) 
     Set TZones = oOutl.TimeZones 
     Set sourceTZ = TZones.Item(TZfrom) 
     Set destTZ = TZones.Item(TZto) 
     ConvertTime = TZones.ConvertTime(DT, sourceTZ, destTZ) + seconds 'add the stripped seconds 
    End If 
End Function 

Sub test_ConvertTime() 
    Dim t As Date 

    t = #8/23/2017 6:15:05 AM# 
    Debug.Print t, ConvertTime(t), Format(t - ConvertTime(t), "h") 
End Sub