Ottieni informazioni sul fuso orario in VBA (Excel)

Question

Vorrei stabilire un fuso orario a GMT/UTC (inclusa l'ora legale) per diversi paesi in una data specifica in VBA. Qualche idea?

EDIT (da auto-risposta):

Grazie 0xA3. Ho letto velocemente la pagina collegata. Suppongo che si può ottenere solo l'offset GMT per il locale in cui Windows è in esecuzione:

ConvertLocalToGMT  
DaylightTime 
GetLocalTimeFromGMT   
LocalOffsetFromGMT 
SystemTimeToVBTime 
LocalOffsetFromGMT 

In Java è possibile effettuare le seguenti operazioni:

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)); 

Ciò significa posso ottenere l'offset per i diversi paesi (fusi orari) e quindi posso anche ottenere il tempo reale diciamo in bucarest. Posso farlo in VBA?

Answer 1

VBA non offre funzioni per farlo, ma l'API di Windows fa. Fortunatamente è possibile utilizzare tutte queste funzionalità anche da VBA. Questa pagina descrive come farlo:

Time Zones And Daylight Savings Time

Answer 2

Qui è il codice a cui fa riferimento la risposta 0xA3. Ho dovuto modificare le dichiarazioni di dichiarazione per consentirle di funzionare correttamente in Office 64bit ma non sono stato in grado di eseguire nuovamente il test in Office 32bit. Per il mio utilizzo stavo cercando di creare date ISO 8601 con informazioni sul fuso orario. Quindi ho usato questa funzione per quello.

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 

Il codice qui sotto è venuto da 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

Si prega di essere consapevoli di piccola trappola nella soluzione.

L'() chiamata GetTimeZoneInformation restituisce DST informazioni sul ora corrente, ma la data convertito potrebbe essere di periodo con la diversa impostazione di ora legale - convertendo quindi data gennaio ad agosto si applicherebbe l'attuale Bias, ottenendo così il GMT data 1 ora meno di quella corretta (SystemTimeToTzSpecificLocalTime sembra essere una migliore vestibilità - ancora sottoposti a verifica)

lo stesso vale quando la data è da un altro anno - quando le regole DST sarebbero andate diversamente. GetTimeZoneInformationForYear dovrebbe gestire le modifiche in anni diversi. Inserirò un esempio di codice qui una volta completato.

Sembra inoltre che Windows non fornisca un modo affidabile per ottenere l'abbreviazione di 3 lettere del fuso orario (Excel 2013 supporta zzz in Format() - non testato).

Modifica 16.04.2015: IntArrayToString() rimosso poiché è già presente in modWorksheetFunctions.bas a cui si fa riferimento negli articoli cpearson.com riportati di seguito.

Aggiunta di codice da convertire utilizzando il fuso orario attivo al momento della data di conversione (questo problema non è indirizzato su cpearson.com). La gestione degli errori non è inclusa per brevità.

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 

Ci sono 2 modi per raggiungere offset:

1. sottrarre data locale e convertiti data gmt:

   offset = (lpDateLocal - lpDateGmt)*24*60

2. ottenere TZI per l'anno specifico e calcolare:

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

Caveat: Per qualche ragione, i valori popolati in lpTZI qui non contengono le informazioni dell'anno, quindi è necessario impostare l'anno in lpTZI.DaylightDate e lpTZI.StandardDate.

Answer 4

vi consiglio di creare un oggetto di Outlook e utilizzare il built-in metodo ConvertTime: https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

Super facile, super salvare e poche righe di codice

Questo esempio converte l'inputTime da UTC a CET:

Come fuso orario di origine/destinazione è possibile utilizzare tutti i fusi orari che è possibile trovare nel proprio registro sotto: 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: se avete spesso usare il metodo, vi consiglio di dichiarare l'oggetto di Outlook al di fuori della vostra sub/funzioni . Creala una volta e mantienila viva.

Answer 5

Sulla base dell'ottima raccomandazione di Julian Hess di utilizzare le funzionalità di Outlook, ho creato questo modulo, che funziona con Access ed 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