Private Sub Timer1_Timer()
Dim datUTC As Date
datUTC = Time_LocalToUTC(Now)
Me.lblCurrentTimeActual.Caption = Now
Me.lblUTCTimeActual.Caption = CStr(datUTC)
Me.lblPhilippinesTimeActual.Caption =
CStr(DateAdd("h", 8, datUTC))
End Sub
Public Function Time_LocalToUTC(ByVal
the_date As Date) As Date
On Error GoTo ErrorTrap
' Create a new instance of the WScript
Shell
Dim oWshshell As Variant
Dim UTCOffset As Long
Set oWshshell =
CreateObject("WScript.Shell")
'Скопировать смещение часов универсального времени из реестра, которое учитывает переход на летнее время
UTCOffset = oWshshell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
' Возьмите текущее системное время и добавьте смещение UTC из реестра.1440 получается 'путем взятия 60 * 24, так как единицы для дня имеют 1, равный день. Time_LocalToUTC = the_date + (UTCOffset / 1440) GoTo EndCleanup ErrorTrap: MsgBox "Ошибка:" & Err.Description, vbOKCancel, "Ошибка при получении UTCВремя "
EndCleanup:
Set oWshshell = Nothing
End Function[enter image description here]
[1]