2010-06-25 120 views
12

Me gustaría determinar una compensación de tiempo para GMT/UTC (incluido el horario de verano) para diferentes países en una fecha específica en VBA. ¿Algunas ideas?Obtener información de zona horaria en VBA (Excel)

EDITAR (de auto-respuesta):

Gracias 0xA3. Leí rápidamente la página enlazada. Asumo que sólo se puede obtener la compensación a GMT para el local donde se está ejecutando Windows:

ConvertLocalToGMT  
DaylightTime 
GetLocalTimeFromGMT   
LocalOffsetFromGMT 
SystemTimeToVBTime 
LocalOffsetFromGMT 

En Java se puede hacer lo siguiente:

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

Esto significa que puedo conseguir el desplazamiento para diferentes países (zonas horarias) y yo también puedo obtener el tiempo real digamos en Bucarest. ¿Puedo hacer esto en VBA?

Respuesta

9

VBA no ofrece funciones para hacer eso, pero sí la API de Windows. Afortunadamente también puedes usar todas esas funcionalidades de VBA. Esta página describe cómo hacerlo:

Time Zones And Daylight Savings Time

+2

+1 Pero sugiero pegar (o escribir, si crees que pueden surgir problemas de copyright) el código correspondiente aquí también. Si el sitio de origen falla, permanecerá aquí para futura referencia –

+0

@belisarius: Buen punto, espero que yo u otra persona tengamos el tiempo para hacerlo más tarde ;-) –

+0

Agregué el código como una respuesta adicional a la pregunta. Aunque tuve que hacer un cambio en las declaraciones Declare para permitir que funcione correctamente con Office 64 bit. – RobbZ

5

Este es el código que se hace referencia en la respuesta por 0xA3. Tuve que cambiar las declaraciones de declaración para permitir que se ejecutara correctamente en Office 64bit pero no he podido volver a probar en Office 32 bits. Para mi uso, estaba tratando de crear fechas ISO 8601 con información de zona horaria. Entonces utilicé esta función para eso.

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 

El código a continuación fue tomada http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx

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

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


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

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

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

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

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




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

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

End Function 


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

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

End Function 

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

End Function 

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

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

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

LocalOffsetFromGMT = TBias 

End Function 

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

Tenga en cuenta lo pequeña trampa en la solución.

El() llamada GetTimeZoneInformation devuelve información DST acerca de la hora actual, pero la fecha convertida podría ser de la época con el diverso ajuste del horario de verano - convirtiendo así enero la fecha en agosto se aplicaría la corriente de polarización, produciendo así el GMT fecha de 1 hora menos que la correcta (SystemTimeToTzSpecificLocalTime parece ser un mejor ajuste - no probado aún)

lo mismo se aplica cuando la fecha es de un año - cuando las reglas de DST podrían haber sido diferentes. GetTimeZoneInformationForYear debe manejar los cambios en años diferentes. Voy a poner una muestra de código aquí una vez completada.

También parece que Windows no proporciona una forma confiable de obtener una abreviatura de 3 letras de la zona horaria (Excel 2013 admite zzz en Formato() - no probado).

Editar 04.16.2015: IntArrayToString() elimina, ya que ya está presente en modWorksheetFunctions.bas referencia en artículos cpearson.com mencionados a continuación.

Agregando código para convertir utilizando la zona horaria activa en el momento de la fecha de conversión (este problema no se aborda en cpearson.com). El manejo de errores no está incluido por brevedad.

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 

Hay 2 maneras de lograr offset:

  1. restar fecha local y convertidos fecha GMT:

    offset = (lpDateLocal - lpDateGmt)*24*60

  2. obtener TZI por año específico y calcular:

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

Advertencia: Por alguna razón, los valores pobladas en lpTZI aquí no contienen la información del año, por lo que necesita para ajustar el año en lpTZI.DaylightDate y lpTZI.StandardDate.

+1

Vale la pena señalar esa trampa: hay un período de 7 días cada año cuando Londres y Nueva York se encuentran en diferentes modos de ahorro de luz diurna. Si está importando datos con marcas de tiempo de las aplicaciones en estas dos ubicaciones, * encontrará * esta trampa durante ese período. –

+0

Lo que más me sorprende es que nadie ha reportado el mismo problema usando VBA e incluso los grandes scripts de cpearson no lo manejan (e incluso el procesamiento de datos de 6 meses en su propia zona horaria tiene que toparse con esto). – chukko

2

me recomiendan para crear un objeto de Outlook y utilizar el incorporado método ConvertTime: https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

Super fácil, super parada de sólo unas pocas líneas de código

En este ejemplo se convierte el inputTime de UTC a CET:

Como zona horaria de origen/destino puede utilizar todas las zonas horarias, puede encontrar en su registro en: HKEY_LOCAL_MACHINE/SOFTWARE/NT/CurrentVersion/Zonas de tiempo/Microsoft Windows/

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 

PD: si usted a menudo tiene que utilizar el método, recomiendo a declarar el objeto de Outlook fuera de su sub/función . Créelo una vez y manténlo vivo.

+0

Esto se ve muy interesante, pero ¿cómo se proporcionan las zonas horarias de origen y destino? ¿Podría incluso proporcionar una pequeña muestra? Thx –

+0

thx. Sin embargo, el código proporcionado no parece compilarse. ConvertTime requiere un objeto 'TimeZone' para los parámetros 2d y 3d, no una cadena. –

+1

@PatrickHonorez por favor actualice la página para ver el código correcto –

0

Basado en la excelente recomendación de Julian Hess para usar las capacidades de Outlook, tengo que compilar este módulo, que funciona con Access y 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 
Cuestiones relacionadas