Extraer la zona horaria del PC en visual basic

Option Explicit
Private Const CP_ACP = 0
Private Declare Function GetTimeZoneInformation Lib _
"kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" _
(ByVal codepage As Long, ByVal dwFlags As Long, _
LpWideCharStr As Any, ByVal cchWideChar As Long, _
LpMultiByteStr As Any, ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
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(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Sub Form_Load()
MsgBox GetTimeZoneName
End Sub
Private Function GetUTCTime() As Date
Dim tz As TIME_ZONE_INFORMATION
Dim lRV As Long
Dim dRV As Date
lRV = GetTimeZoneInformation(tz)
dRV = DateAdd("n", CDbl(tz.Bias), Now)
GetUTCTime = dRV
End Function
Private Function GetTimeZoneOffset() As Integer
Dim tz As TIME_ZONE_INFORMATION
Dim lRV As Long
Dim iRV As Integer
lRV = GetTimeZoneInformation(tz)
' offset is indicated in minutes
iRV = tz.Bias
GetTimeZoneOffset = iRV
End Function
Private Function GetTimeZoneName() As String
Dim tz As TIME_ZONE_INFORMATION
Dim lRV As Long
Dim sRV As String
Dim lCounter As Long
Dim wchar(1) As Byte
lRV = GetTimeZoneInformation(tz)
' the TZ Name is stored in Wide Chars, we will extract by just grabbing first byte of each digit and mapping
' to ASCII. Should be safe for most of the time.
sRV = GetStrFromPtrW(VarPtr(tz.StandardName(0)))
GetTimeZoneName = sRV
End Function
Public Function GetStrFromANSIBuffer(sBuf As String) As String
If InStr(sBuf, &H0) Then
GetStrFromANSIBuffer = Left(sBuf, InStr(sBuf, &H0) - 1)
Else
GetStrFromANSIBuffer = sBuf ' no null, so don't worry about it
End If
End Function
Public Function GetStrFromPtrW(lpszW As Long) As String
Dim sRV As String
sRV = String$(lstrlenW(ByVal lpszW) * 2, &H0) ' 2 bytes/char
' copy from Unicode string into new buffer
WideCharToMultiByte CP_ACP, &H0, ByVal lpszW, -1, ByVal sRV, Len(sRV), &H0, &H0
GetStrFromPtrW = GetStrFromANSIBuffer(sRV)
End Function