Back

Topic

[KB552]Chrono, UTC, Local hour in VBA

Tags: Scripting, VBA

14 years ago
By ACHT
Options
Print
Applies to:

PcVue all versions.


Summary:

This article contains a set of useful VBA functions for the conversion of datetime values from UTCtime to local time or Chrono values to datetime values and vice-versa.


Details:

You will find here below full content of mdChronoConvertion VBA module attached

Attribute VB_Name = “mdChronoConvertion”
Option Explicit

 ‘—————————————————————————————–

‘Internal 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(31) As Integer
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName(31) As Integer
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

 ‘—————————————————————————————–

‘Functions from the Windows API’s

Private Declare Function SystemTimeToTzSpecificLocalTime Lib “kernel32” _
  (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION, ByRef lpUniversalTime As SYSTEMTIME, ByRef lpLocalTime As SYSTEMTIME) As Integer

Private Declare Function TzSpecificLocalTimeToSystemTime Lib “kernel32” _
  (ByRef lpTimeZoneInformation As TIME_ZONE_INFORMATION, ByRef lpLocalTime As SYSTEMTIME, ByRef lpUniversalTime As SYSTEMTIME) As Integer

Private Declare Function GetTimeZoneInformation _
  Lib “kernel32” (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

‘—————————————————————————————–

‘Internal functions for simple conversion

Private Function SystemTimeToDate(lpSystemTime As SYSTEMTIME) As Date
  Dim retDate As Date
  retDate = DateTime.DateSerial(lpSystemTime.wYear, lpSystemTime.wMonth, lpSystemTime.wDay) + DateTime.TimeSerial(lpSystemTime.wHour, lpSystemTime.wMinute, lpSystemTime.wSecond)
  SystemTimeToDate = retDate
End Function

Private Function DateToSystemTime(dtDate As Date) As SYSTEMTIME
  Dim stResult As SYSTEMTIME
  stResult.wYear = DateTime.Year(dtDate)
  stResult.wMonth = DateTime.Month(dtDate)
  stResult.wDay = DateTime.Day(dtDate)
  stResult.wDayOfWeek = DateTime.Weekday(dtDate)
  stResult.wHour = DateTime.Hour(dtDate)
  stResult.wMinute = DateTime.Minute(dtDate)
  stResult.wSecond = DateTime.Second(dtDate)
  stResult.wMilliseconds = 0
  DateToSystemTime = stResult
End Function

Private Function DateToChrono(dtDate As Date) As Double
  Dim dblResult As Double
  Dim dtRefDate As Date
  dtRefDate = “01/01/1970 00:00:00”
  dblResult = DateTime.DateDiff(“s”, dtRefDate, dtDate)
  dblResult = dblResult * 10000000 + 1.16444736E+17
  DateToChrono = dblResult
End Function

Private Function ChronoToDate(dblChrono As Double) As Date
  Dim dtResult As Date
  Dim dtRefDate As Date
  Dim lNbSec As Long
  lNbSec = (dblChrono – 1.16444736E+17) / 10000000
  dtRefDate = “01/01/1970 00:00:00”
  dtResult = DateTime.DateAdd(“s”, lNbSec, dtRefDate)
  ChronoToDate = dtResult
End Function

 ‘—————————————————————————————–

‘Public functions

Public Function UTCTimeToLocalTime(dtUTC As Date) As Date
  Dim dtResult As Date
  Dim lpTimeZone As TIME_ZONE_INFORMATION
  Dim lpUniversalTime As SYSTEMTIME
  Dim lpLocalTime As SYSTEMTIME
  lpUniversalTime = DateToSystemTime(dtUTC)
  GetTimeZoneInformation lpTimeZone
  SystemTimeToTzSpecificLocalTime lpTimeZone, lpUniversalTime, lpLocalTime
  dtResult = SystemTimeToDate(lpLocalTime)
  UTCTimeToLocalTime = dtResult
End Function

Public Function LocalTimeToUTCTime(dtLocal As Date) As Date
  Dim dtResult As Date
  Dim lpTimeZone As TIME_ZONE_INFORMATION
  Dim lpUniversalTime As SYSTEMTIME
  Dim lpLocalTime As SYSTEMTIME
  lpLocalTime = DateToSystemTime(dtLocal)
  GetTimeZoneInformation lpTimeZone
  TzSpecificLocalTimeToSystemTime lpTimeZone, lpLocalTime, lpUniversalTime
  dtResult = SystemTimeToDate(lpUniversalTime)
  LocalTimeToUTCTime = dtResult
End Function

Public Function UTCTimeToPcVueChrono(dtUTC As Date) As Double
  Dim dblResult As Double
  dblResult = DateToChrono(dtUTC)
  UTCTimeToPcVueChrono = dblResult
End Function

Public Function LocalTimeToPcVueChrono(dtLocal As Date) As Double
  Dim dblResult As Double
  Dim dtUTC As Date
  dtUTC = LocalTimeToUTCTime(dtLocal)
  dblResult = DateToChrono(dtUTC)
  LocalTimeToPcVueChrono = dblResult
End Function

Public Function PcVueChronoToUTCTime(dblChrono As Double) As Date
  Dim dtResult As Date
  dtResult = ChronoToDate(dblChrono)
  PcVueChronoToUTCTime = dtResult
End Function

Public Function PcVueChronoToLocalTime(dblChrono As Double) As Date
  Dim dtResult As Date
  Dim dtUTC As Date
  dtUTC = ChronoToDate(dblChrono)
  dtResult = UTCTimeToLocalTime(dtUTC)
  PcVueChronoToLocalTime = dtResult
End Function

Download attachments: mdChronoConvertion.zip


Created on: 09 Mar 2012 Last update: 13 May 2024