How to Fix the Problem When ADO Truncates Milliseconds from SQL Server Datetime Columns

SOLUTION 3 - Use a Custom VB Function

Apparently, the only way to do this is to do it ourselves with a custom VB function that infers the milliseconds using a moderately complex algorithm (see below).

But the results are right on, as you can see from this example:

? FormatDateTimeWithMS(rs(0))

20020809 23:15:27:490

Heres the code for this custom VB function. I hope you find it useful.

Public Function FormatDateTimeWithMS(ByVal dDate As Date, Optional strFormat)

Dim lMilliseconds As Long
Dim bSecondRoundedToUpper As Boolean
lMilliseconds = GetMilliseconds(dDate, bSecondRoundedToUpper)

' if the second gets rounded to upper substract one second
If bSecondRoundedToUpper Then
dDate = DateAdd("s", -1, dDate)
End If

' check of the strFormat is missing
If Not IsMissing(strFormat) Then
FormatDateTimeWithMS = Format(dDate, strFormat)
Else
FormatDateTimeWithMS = Format(dDate, "yyyymmdd Hh:Nn:Ss") ' You can add your own format
End If

FormatDateTimeWithMS = FormatDateTimeWithMS & ":" & Format(lMilliseconds, "000000")

End Function

Public Function GetMilliseconds(dOriginalDate As Date, ByRef bSecondRoundedToUpper As Boolean) As Long

' get the string (without milliseconds)
Dim strDateTime As String
strDateTime = CStr(dOriginalDate)

' return it to the datetime (this one doesn't have milliseconds)
Dim dRoundedDateTime As Date
dRoundedDateTime = CDate(strDateTime)

' check if we're below the zero
If dOriginalDate > 0 Then
' check if the rounded date is after the original
If dRoundedDateTime > dOriginalDate Then
' substract one second
dRoundedDateTime = DateAdd("s", -1, dRoundedDateTime)

' return the flag set to on
bSecondRoundedToUpper = True
Else
' return the flag set to off
bSecondRoundedToUpper = False
End If
Else
' check if the rounded date is before the original
If dRoundedDateTime < dOriginalDate Then
' add one second (by deducting it! - bug in VB?)
dRoundedDateTime = DateAdd("s", -1, dRoundedDateTime)

' return the flag set to on
bSecondRoundedToUpper = True
Else
' return the flag set to off
bSecondRoundedToUpper = False
End If

End If

' milliseconds are the number of ms in one day by the difference of the rounded and the orignal date
GetMilliseconds = 86400000 * Abs(dOriginalDate - dRoundedDateTime)
End Function

' TEST SUB
Public Sub TestMilliseconds

Dim cn As New ADODB.Connection
cn.ConnectionString = "driver={SQL Server};server=(local);uid=sa;pwd=q;database=pubs"
cn.Open

Dim cm As New ADODB.Command
Set cm.ActiveConnection = cn
cm.CommandText = "select getdate(), convert(varchar,getdate(),21)"
cm.CommandType = adCmdText

Dim rs As ADODB.Recordset
Set rs = cm.Execute

Dim strVBFormat As String
strVBFormat = FormatDateTimeWithMS(rs(0).Value)

MsgBox "SERVER FORMAT: " & rs(1).Value & vbCrLf & "VB FORMAT: " & strVBFormat

End Sub

Published with the express written permission of the author. Copyright 2002