programing

VBA(Excel)에서 표준 시간대 정보 가져오기

powerit 2023. 7. 2. 21:02
반응형

VBA(Excel)에서 표준 시간대 정보 가져오기

VBA의 특정 날짜에 국가별로 GMT/UTC(여름 시간 포함)까지의 시간 오프셋을 결정하고 싶습니다.아이디어 있어요?

편집(자체 답변에서):

0xA3 감사합니다.저는 링크된 페이지를 빠르게 읽습니다.윈도우가 실행 중인 로컬에 대해서만 GMT로 오프셋을 얻을 수 있다고 가정합니다.

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의 모든 기능을 사용할 수 있습니다.이 페이지에서는 방법을 설명합니다.표준 시간대 및 일광 절약 시간


편집: 추가된 코드

후세를 위해 32bit Office VBA에서 사용할 수 있는 Guru Chip 페이지의 전체 코드를 추가했습니다. (여기서 64bit 수정)

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 설정이 다른 기간일 수 있습니다. 따라서 8월의 1월 날짜를 변환하면 현재 바이어스가 적용됩니다.따라서 정확한 날짜보다 1시간 적은 GMT 날짜를 산출합니다(SystemTimeToTzSpecificLocalTime이 더 적합한 것 같습니다. 아직 테스트되지 않았습니다).

DST 규칙이 다를 수 있는 다른 연도의 날짜인 경우에도 마찬가지입니다.GetTimeZoneInformationForYear는 다른 연도의 변경사항을 처리해야 합니다.완료되면 코드 샘플을 여기에 넣겠습니다.

또한 Windows는 표준 시간대의 3글자 축약을 얻을 수 있는 신뢰할 수 있는 방법을 제공하지 않는 것 같습니다(Excel 2013은 zz를 지원하는 형식() - 테스트되지 않음).

편집 16.04.2015: 아래 언급된 cpearson.com 기사에서 참조된 modWorksheetFunctions.bas에 이미 존재하기 때문에 IntArrayToString()이 제거되었습니다.

변환된 날짜에 활성 시간대를 사용하여 변환할 코드를 추가합니다(이 문제는 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

오프셋을 설정하는 두 가지 방법이 있습니다.

  1. 로컬 날짜 및 변환된 gmt 날짜를 뺍니다.

    offset = (lpDateLocal - lpDateGmt)*24*60

  2. 특정 연도에 대한 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로 연도를 설정해야 합니다.일광 날짜 및 lpTZI.표준 날짜.

여기 0xA3에서 답변에 참조되는 코드가 있습니다.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

Outlook 개체를 만들고 내장 메서드 ConvertTime을 사용하는 것이 좋습니다. https://msdn.microsoft.com/VBA/Outlook-VBA/articles/timezones-converttime-method-outlook

매우 간편하고, 매우 저장 및 몇 줄의 코드만 가능

다음 예제에서는 입력 시간을 UTC에서 CET로 변환합니다.

소스/대상 표준시로 레지스트리에서 HKEY_LOCAL_MACHINE/소프트웨어/Microsoft/Windows NT/현재 버전/표준시/에 있는 모든 표준시를 사용할 수 있습니다.

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 개체를 하위/기능 외부에 선언하는 것이 좋습니다.한 번 생성하여 계속 유지합니다.

Outlook 기능을 사용하기 위한 Julian Hess의 우수한 추천을 바탕으로 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 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

Outlook에서 표준 시간대 정보에 대한 (느린) 바로 가기를 제공할 수도 있지만 일반 솔루션의 경우 위에 게시된 것보다 훨씬 많은 코드가 필요하고 일부 정보가 현지화되어 있기 때문에 여기에 게시하기에는 너무 많은 코드가 필요합니다.

프로젝트 VBA의 핵심 기능입니다.표준 시간대-Windows는 다음과 같습니다.

' 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

이 프로젝트는 두 개의 기사에 의해 지원됩니다.

IMT-2000 3GPP-표준 시간대, Windows 및 VBA - Part 1

표준시, Windows 및 Microsoft Office - 2부

액세스 및 Excel 데모를 포함합니다.

enter image description here

다음은 반환된 IsDST 값을 CheckDST와 비교한 다음 그에 따라 시간대 날짜/시간 값을 조정하여 유용할 수 있는 여러 기능입니다.예:

Dim SomeDateTime As Date 'Or Double

If IsDST Then
    'Is currently DST, so add an hour if the date/time to be checked includes a standard-time date.
    
    If Not CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime + TimeSerial(1, 0, 0)
Else
    'Is not currently DST, so subtract an hour if the date/time to be checked includes a DST date.
    
    If CheckDST(SomeDateTime) Then SomeDateTime = SomeDateTime - TimeSerial(1, 0, 0)
End If

DST 확인:전체 기능 버전.일광 절약 시간(또는 영국 서머타임)이 지정된 날짜(선택적으로 지정된 로케일)에 적용되면 True를 반환하고, 그렇지 않으면 False를 반환합니다.닉슨 대통령의 1973년 "긴급 일광 절약 시간 에너지 절약법"과 해롤드 윌슨의 "영국 표준시" 실험(1968년 10월 27일 ~ 1971년 10월 31일)을 포함하여 1966년까지의 모든 미국 DST(및 영국 BST) 시스템 변형을 처리합니다.

DST_UK1972: 단순화된 버전을 확인합니다.1972년 이후 정의된 BST 시스템을 기준으로 영국 여름 시간이 지정된 날짜에 적용되면 True를 반환하고, 그렇지 않으면 False를 반환합니다.

DST_US2007: 단순화된 버전을 확인합니다.2007년에 설정된 DST 시스템을 기준으로 지정된 날짜에 미국 연방 일광 절약 시간이 적용되면 True를 반환하고, 그렇지 않으면 False를 반환합니다.

IsDST: 일광 절약 시간이 현재(선택적으로 지정된 로케일에서) 적용 중이면 True를 반환하고, 그렇지 않으면 False를 반환합니다.

NthDayOfWeekDate: 지정된 달의 지정된 요일 N번째 인스턴스의 날짜를 반환합니다.

Option Explicit

Public Function CheckDST(ChkDate As Variant, Optional Locale As String = "USA") As Boolean
    '
    'Returns True if Daylight Savings Time applies to the specified date (in the optionally specified locale);
    'otherwise returns False.  Note that this function handles all dates back to 1/1/1966.  For dates prior to
    'that, an error message is displayed due to the difficulty of handling the highly inconsistent use of DST in
    'prior years, across various locales.
    '
    'PARAMETERS:
    '
    '   ChkDate     The date to be checked for DST status.  The data-type of the calling code's argument can
    '               be either Date or Double.
    '
    '   Locale      The geographic locale within which that locale's DST rules are to be applied. Values:
    '                   "AZ"    - DST hasn't applied to Arizona since 1967.
    '                   "NN"    - DST has applied in the Navajo Nation of northeastern Arizona.
    '                   "AS"    - DST has never applied in American Samoa (since WWII).
    '                   "GU"    -   "   Guam.
    '                   "HI"    -   "   Hawaii.
    '                   "MP"    -   "   Northern Marina Islands.
    '                   "PR"    -   "   Puerto Rico.
    '                   "VI"    -   "   Virgin Islands.
    '                   "UK"    - British Summer Time (BST) has been applied since the end of WWII (1945), from
    '                             the last Sunday of March through the last Sunday of October, with one exception
    '                             period from 1968 through 1971 in which it applied all year long (see details
    '                             below).
    '                   "USA"   - All other states in the US, for which the federal DST rules have applied.
    '                             Correctly handles President Nixon's "Emergency Daylight Saving Time Energy
    '                             Conservation Act" of 1973.
    '
    'AUTHOR: Peter Straton
    '
    '*************************************************************************************************************

    Const ThisFunction As String = "Function CheckDST()"

    Const First As Integer = 1  'First instance in a month
    Const Secnd As Integer = 2  'Second instance in a month
    Const Last  As Integer = 5  'Last instance: use max possible in a month

    Const Mar As Integer = 3, Apr As Integer = 4, Oct As Integer = 10, Nov As Integer = 11

    Const LawYearIdx As Integer = 0, StartInstanceIdx As Integer = 1, StartMonthIdx As Integer = 2, _
          EndInstanceIdx As Integer = 3, EndMonthIdx As Integer = 4

    Dim DateYear As Integer
    Dim i As Integer
    Dim StartInstance As Integer, StartMonth As Integer, EndInstance As Integer, EndMonth As Integer
    Static US_StartEndSpecs As Variant

    DateYear = Year(ChkDate)
    If DateYear < 1966 Then
        MsgBox "The specified date, " & ChkDate & ", is prior to this function's minimum date-year (1966) " & _
               "which is necessary due to highly inconsistent use of DST in prior years, over various locales.", _
               vbOKOnly + vbCritical, ThisFunction
        Exit Function  'Return default: False
    End If

    Select Case Locale
    Case "USA", "NN"    'Check these cases first, for execution efficiency and locale-logic shortcut
        If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/26/1975") Then
            'Non-algorithmic case: On January 4, 1974, President Nixon signed the Emergency Daylight Saving Time
            'Energy Conservation Act of 1973.  Beginning on January 6, 1974, clocks were set ahead. On October 5,
            '1974, Congress amended the Act, and Standard Time returned on October 27, 1974. Daylight Saving Time
            'resumed on February 23, 1975 and ended on October 26, 1975.
            '
            'NOTE: Arizona was exempted.

            If ChkDate >= DateValue("1/6/1974") And ChkDate < DateValue("10/27/1975") Or _
               ChkDate >= DateValue("2/23/1975") And ChkDate < DateValue("10/26/1975") Then

                CheckDST = True
                Exit Function
            End If
        'Else
            'Continue with DST calculation below...
        End If

    Case "UK"   'Check this case next, for execution efficiency and locale-logic shortcut
        If ChkDate >= DateValue("10/27/1968") And ChkDate < DateValue("10/31/1971") Then
            'Non-algorithmic case: The Harold Wilson government adopted "British Standard Time" (actually GMT+1,
            'equivalent to DST) *throughout* the year.  This took place between October 27, 1968 and October 31,
            '1971 when there was a reversion back to the previous arrangement.

            CheckDST = True
            Exit Function   'Return default: False
        'Else
            'Continue with DST calculation below...
        End If

        StartInstance = Last: StartMonth = Mar 'Last Sunday of March
        EndInstance = Last: EndMonth = Oct     'Last Sunday of October

    Case "AZ"
        If DateYear > 1967 Then Exit Function   'Hasn't participated in DST since 1967; return default: False

    Case "AS", "GU", "HI", "MP", "PR", "VI"
        Exit Function  'None of these have participated in DST (since WWII); return default: False

    Case Else
        MsgBox "Unknown Locale specification: """ & Locale & """", vbOKOnly + vbCritical, ThisFunction
    End Select

    If StartInstance = 0 Then '(If not defined above)
        'If necessary, (re)initialize the DST start/end specs by DST law-date lookup table for the USA, then find
        'the DST rule specs that apply, based on the specified date's year vs. the rule start-date years.

        If IsEmpty(US_StartEndSpecs) Then '(Re)init if necessary...
            US_StartEndSpecs = Array(Array(2007, Secnd, Mar, First, Nov), _
                                     Array(1986, First, Mar, Last, Oct), _
                                     Array(1966, Last, Apr, Last, Oct))
        End If
        For i = LBound(US_StartEndSpecs, 1) To UBound(US_StartEndSpecs, 1)
            If DateYear >= US_StartEndSpecs(i)(LawYearIdx) Then Exit For
        Next i
        If i > UBound(US_StartEndSpecs, 1) Then
            Stop 'DEBUG: SHOULD NEVER EXECUTE TO HERE DUE TO ChkDate PARAMETER VALUE CHECK, ABOVE.
            Exit Function
        End If

        StartInstance = US_StartEndSpecs(i)(StartInstanceIdx)   'n-th Sunday of...
        StartMonth = US_StartEndSpecs(i)(StartMonthIdx)         'some month
        EndInstance = US_StartEndSpecs(i)(EndInstanceIdx)       'm-th Sunday of...
        EndMonth = US_StartEndSpecs(i)(EndMonthIdx)             'some other month
    End If

    'Do the DST calculation based on the specifications defined above

    CheckDST = ChkDate >= NthDayOfWeekDate(StartInstance, vbSunday, DateSerial(DateYear, StartMonth, 1)) And _
               ChkDate < NthDayOfWeekDate(EndInstance, vbSunday, DateSerial(DateYear, EndMonth, 1))
End Function 'CheckDST

Public Function CheckDST_UK1972(ChkDate As Date) As Boolean
    '
    'Returns True if the UK "British Summer Time" applies to the specified date, based on the BST system as it's
    'been defined since 1972; otherwise returns False.  Note that this function does not take into account Harold
    'Wilson's experimental "British Standard Time" which took place between October 27, 1968 and October 31, 1971.
    'To correctly handle that date range, use the CheckDST function instead.
    '
    'PARAMETERS:
    '
    '   ChkDate     The date to be checked for DST status.
    '
    'AUTHOR: Peter Straton
    '
    '*************************************************************************************************************

    Const Last As Integer = 5   'Last instance: use max possible in a month
    Const Mar As Integer = 3, Oct As Integer = 10
    Dim DateYear As Integer: DateYear = Year(ChkDate)

    CheckDST_UK1972 = ChkDate >= NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Mar, 1)) And _
                      ChkDate < NthDayOfWeekDate(Last, vbSunday, DateSerial(DateYear, Oct, 1))
End Function 'CheckDST_UK1972

Public Function CheckDST_US2007(ChkDate As Date) As Boolean
    '
    'Returns True if the US Federal "Daylight Savings Time" applies to the specified date, based on the DST system
    'established in 2007; otherwise returns False.  Note that this function does not take into account locales
    'such as Arizona, Hawaii or various US protectorates (Puerto Rico, Guam, etc.) so results for those locales
    'will be unreliable.  To correctly handle those locales, use the CheckDST function instead.
    '
    'PARAMETERS:
    '
    '   ChkDate     The date to be checked for DST status.
    '
    'AUTHOR: Peter Straton
    '
    '*************************************************************************************************************

    Const First As Integer = 1  'First instance in a month
    Const Secnd As Integer = 2  'Second instance in a month
    Const Mar As Integer = 3, Nov As Integer = 11
    Dim DateYear As Integer: DateYear = Year(ChkDate)

    CheckDST_US2007 = ChkDate >= NthDayOfWeekDate(Secnd, vbSunday, DateSerial(DateYear, Mar, 1)) And _
                      ChkDate < NthDayOfWeekDate(First, vbSunday, DateSerial(DateYear, Nov, 1))
End Function 'CheckDST_US2007

Public Function IsDST(Optional Locale As String = "USA") As Boolean
    '
    'Returns True if Daylight Savings Time is *currently* in effect (in the optionally specified locale);
    'otherwise returns False.
    '
    '*************************************************************************************************************

    IsDST = CheckDST(Now(), Locale)
End Function

Function NthDayOfWeekDate(ByVal Instance As Integer, DayOfWeek As Integer, ByVal MonthDate As Date) As Date
    '
    'Returns the Date of the specified Nth instance of the specified day-of-week in the specified month.
    '
    'PARAMETERS:
    '
    '   Instance    The instance-number specified day-of-week in the month.  To get the date of *last* instance in
    '               the month of the specified day-of-week, pass the value 5 as the argument to this parameter.
    '
    '   DayOfWeek   The day-number of the day-of-week for which the Nth instance is to be calculated.  Can be any
    '               of: vbSunday, vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday, vbSaturday.
    '
    '   MonthDate   The date of the month in which the Nth day-of-week instance is to be calculated.
    '               (e.g. "3/2020" or "3/1/2020")
    '
    'AUTHOR: Peter Straton
    '
    '*************************************************************************************************************

    Instance = IIf(Instance > 5, 5, Instance)   'Max: 5 possible instances

    MonthDate = DateSerial(Year(MonthDate), Month(MonthDate), 1) 'Ensure that it's the first day of the month
    NthDayOfWeekDate = MonthDate + Instance * 7 - Weekday(MonthDate + 7 - DayOfWeek)

    If Month(NthDayOfWeekDate) <> Month(MonthDate) Then NthDayOfWeekDate = NthDayOfWeekDate - 7 '"Last" instance?
End Function

패트릭 호노레즈의 훌륭한 해결책을 몇 가지 수정합니다.

약간의 오류 확인과 몇 가지 추가 테스트. :-)

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

'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

언급URL : https://stackoverflow.com/questions/3120915/get-timezone-information-in-vba-excel

반응형