Excel 2010 Date Bug - What Mark Did

p>If you’re working with DateTmePickers on a VBA form in Excel 2010 be aware that there’s a fairly serious bug with assigning date values affecting the actual system time. For example the following code will change the system time of your PC to 1/1/1899!

  Date = DateSerial(1899,1,1)

This is a big security hole in Office 2010, at least on Windows7 x64 Professional (which is the only place I tested it on). Being able to change the system time so easily is ridiculous. Up until now I’ve had to set the system time from VBA (or VB6 for that matter) by making use of the SetSystemTime API function doing someting like this:

 Public Declare Function SetSystemTime Lib "kernel32" _
   (lpSystemTime As SYSTEMTIME) As Long
   
Public 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

Public 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

Public Declare Function getTimeZoneInformation Lib "kernel32" _
    Alias "GetTimeZoneInformation" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function GetTimeZoneInformationAny Lib "kernel32" Alias _
    "GetTimeZoneInformation" (buffer As Any) As Long

Public Function GetTimeDifference() As Long
   Const TIME_ZONE_ID_INVALID& = &HFFFFFFFF
   Const TIME_ZONE_ID_STANDARD& = 1
   Const TIME_ZONE_ID_UNKNOWN& = 0
  
   Const TIME_ZONE_ID_DAYLIGHT& = 2
    'Returns  the time difference between
    'local & GMT time in seconds.
    'If the  result is negative, your time zone
    'lags behind GMT zone.
    'If the  result is positive, your time zone is ahead.
    
    Dim tz As TIME_ZONE_INFORMATION
    Dim retcode As Long

    Dim Difference As Long
    
    'retrieve the time zone information
    retcode = getTimeZoneInformation(tz)
    
    'convert to seconds

    Difference = -tz.Bias * 60
    'cache the result

    GetTimeDifference = Difference
    
    'if we are in daylight  saving time, apply the bias.
    If retcode = TIME_ZONE_ID_DAYLIGHT& Then

        If tz.DaylightDate.wMonth <> 0 Then
            'if tz.DaylightDate.wMonth = 0 then the daylight
            'saving time change doesn't occur
            GetTimeDifference = Difference - tz.DaylightBias * 60
        End If

    End If
    
End Function

Public Function LocalToUtc(ByVal vdtLocal As Date) As Date   
    Dim Differerence As Long
    Differerence = GetTimeDifference()
    LocalToUtc = DateAdd("s", -1 * Differerence, vdtLocal)
End Function

Public Function setSystemClock(datSet As Date) As Boolean
  Dim ST As modGlobals.SYSTEMTIME
  Dim datUTC As Date
  
  datUTC = modGlobals.LocalToUtc(datSet)
  
  With ST
     .wYear = Year(datUTC)
     .wMonth = Month(datUTC)
     .wDay = Day(datUTC)
     .wHour = Hour(datUTC)
     .wMinute = Minute(datUTC)
     .wSecond = Second(datUTC)
  End With
  If SetSystemTime(ST) Then
    setSystemClock = True
  Else
    setSystemClock = False
  End If
End Function