此函数处理 1971-01-01 之前的日期和一些溢出问题。
Public Function Convert_Microsoft_Json_Date_To_Date(strMicrosoftDate As String) As Date
'Convert_Microsoft_Json_Date_To_Date("/Date(-2208970800000-0530)/") => 1900-01-01
'Convert_Microsoft_Json_Date_To_Date("/Date(2208970800000-0530)/") => 2039-12-31 14:00:00
Dim strProcedureName As String: strProcedureName = "Convert_Microsoft_Json_Date_To_Date"
Dim lngDateNumber As Long
Dim strOffsetSign As String
Dim strOffsetHours As String
Dim strOffsetMinutes As String
Dim dteDateNoOffset As Date
Dim dteRealDate As Date
Dim curSecondToAdd As Currency '+ or -
Dim curSecondLeft As Currency
Dim curSecondMax As Currency
Dim IsOffsetExist As Boolean
On Error GoTo err_
strMicrosoftDate = Replace(strMicrosoftDate, "/", "")
strMicrosoftDate = Replace(strMicrosoftDate, "(", "")
strMicrosoftDate = Replace(strMicrosoftDate, ")", "")
strMicrosoftDate = Replace(strMicrosoftDate, "Date", "")
strOffsetSign = Left(Right(strMicrosoftDate, 5), 1)
strOffsetHours = Left(Right(strMicrosoftDate, 4), 2)
strOffsetMinutes = Right(strMicrosoftDate, 2)
IsOffsetExist = strOffsetSign = "+" Or strOffsetSign = "-"
If IsOffsetExist Then
'Remove the offset part if exist
strMicrosoftDate = Left(strMicrosoftDate, Len(strMicrosoftDate) - 5)
End If
curSecondMax = 1000000000# 'if curSecondToAdd is to high we get overflow, and I do it in 2 step below to get my date
curSecondToAdd = CCur(strMicrosoftDate) / 1000 'Convert miliseconds to seconds
If Abs(curSecondToAdd) > curSecondMax Then
If curSecondToAdd >= 0 Then
dteDateNoOffset = DateAdd("s", curSecondToAdd - curSecondMax, DateSerial(1970, 1, 1))
dteDateNoOffset = DateAdd("s", curSecondMax, dteDateNoOffset)
Else
dteDateNoOffset = DateAdd("s", curSecondToAdd + curSecondMax, DateSerial(1970, 1, 1))
dteDateNoOffset = DateAdd("s", -curSecondMax, dteDateNoOffset)
End If
Else
dteDateNoOffset = DateAdd("s", curSecondToAdd, DateSerial(1970, 1, 1))
End If
'Debug.Print "Date no offset: " & dteDateNoOffset
If IsOffsetExist Then
dteRealDate = DateAdd("h", CInt(strOffsetSign & strOffsetHours), dteDateNoOffset)
dteRealDate = DateAdd("n", CInt(strOffsetSign & strOffsetMinutes), dteRealDate)
Else
dteRealDate = dteDateNoOffset
End If
'Debug.Print "Date real: " & dteRealDate
Convert_Microsoft_Json_Date_To_Date = dteRealDate
err_exit:
Exit Function
err_:
Select Case Err.Number
Case Else
MsgBox Err.Description & " | " & Err.Number & vbCrLf & "Procedure: " & strProcedureName & IIf(Erl <> 0, vbCrLf & "Ligne: " & Erl, ""), vbCritical
Resume err_exit
Resume
End Select
End Function