VBA字符串转换为带毫秒数的日期

Question

我有一个字符串，格式为"yyyy-mm-dd hh:mm:ss.mmm"（其中结尾是毫秒）

我想将其转换为一个数字，最好是一个Date对象，以保留所有信息。

我已经尝试使用CDate()函数，例如：

Dim dateValue As Date
dateValue = CDate("2017-12-23 10:29:15.223")

但是会收到类型不匹配的错误。

- Greedo

---

可能是VB6日期数据类型：精度和格式的重复问题。 - GSerg

可能是Microsecond support for VT_DATE type的重复问题。 - GSerg

Answer 1

Date类型以一秒的精度保存自1899年12月30日以来的天数。虽然仍然可以通过将日期存储在货币类型中来保存毫秒，因为它可以比Date/Double多保存4个额外数字。

因此，一种替代方案是将日期存储为时间戳，表示自1899年12月30日以来的秒数，并使用Currency类型进行表示：

Public Function CDateEx(text As String) As Currency
    Dim parts() As String
    parts = Split(text, ".")
    CDateEx = CCur(CDate(parts(0)) * 86400) + CCur(parts(1) / 1000)
End Function

将时间戳转换为字符串：

要将时间戳转换回字符串，请使用以下代码：

Public Function FormatDateEx(dt As Currency) As String
    FormatDateEx = Format(dt / 86400, "yyyy-mm-dd HH:mm:ss") & "." & ((dt - Fix(dt)) * 1000)
End Function

- michael

---

这是一个很好的解决方案，谢谢Michael。虽然我认为FormatDateEx中有一个小错误。我相信你需要 FormatDateEx = Format( Fix(dt) /86400, ..... 尝试使用 FormatDateEx(CDateEx("15:59:58.921")) 进行测试。如果没有修复，秒数将变成59而不是58（在Excel 2016 64位Windows中）。我没有进行彻底的测试，请小心。 - Jim

FormatDateEx 的最后一部分应该是 "& Format(((dt - Fix(dt)) * 1000),"000")"，否则 74 将会被格式化为 .074 而不是 .74。 - lars pehrsson

Answer 2

使用Left$函数来截取小数点和毫秒部分：

Dim dateValue As Date
dateValue = CDate(Left$("2017-12-23 10:29:15.223", 19))

- ThunderFrame

---

点赞，因为理解日期数据类型的分辨率是秒级别，所以这也是正确的。 - Vic Colborn

Answer 3

以下代码包含了您可能需要管理日期及其毫秒的所有组件。

Private Sub ParseTime()

    Dim strTime As String
    Dim Sp() As String
    Dim Dt As Double

    strTime = "2017-12-23 10:29:15.221"
    Sp = Split(strTime, ".")
    strTime = Sp(0)

    Dt = CDbl(CDate(strTime))
    strTime = "yyyy-mm-dd hh:mm:ss"
    If UBound(Sp) Then
        Dt = Dt + CDbl(Sp(1)) * 1 / 24 / 60 / 60 / (10 ^ Len(Sp(1)))
        strTime = strTime & "." & CInt(Sp(1))
    End If
    Debug.Print Format(Dt, strTime)
End Sub

我不能说我完全满意这个解决方案，因为打印值只是与日期值隐式相等。但是，我发现以前有效的日期/时间格式（如“yyyy-mm-dd hh:mm:ss.000”）自2007年以来似乎不起作用了。不过，应该可以通过上面所包含的格式掩码来证明日期/时间值等于其呈现。

- Variatus

Answer 4

为什么不在获取整秒作为日期值后，使用DateAdd添加最后的0.233秒呢？

Dim Str As String, MS As String
Dim DateValue As Date
Dim L as Integer
Str = "2017-12-23 10:29:15.223"
For L = 1 to Len(Str)
    If Left(Right(Str, L), 1) = "." Then
        MS = "0" & Right(Str, L)
        Str = Left(Str, Len(Str) - L)
        Exit For
    End If
Next L
DateValue = CDate(Str)
If MS <> "" Then DateValue = DateAdd("S",MS,DateValue)

- Sercho

---

不幸的是，正如其他答案所强调的那样，问题出在“日期”数据类型上；它不能保留毫秒精度的数字。因此，“DateAdd”没有效果，因为日期的小数部分被截断了。您可以在“DateAdd”之前和之后使用“debug.print DateValue”进行测试。 - Greedo

Answer 5

迈克尔的答案有一个错误（由吉姆发现），当小数部分四舍五入时会出错。

以下是纠正错误的方法（稍作修改，以十分之一秒为单位，并使用参数化格式模式）。

Public Function FormatDateEx(dt As Currency, formatPattern As String) As String
    Rem FormatDateEx = Format(dt / 86400, "yyyy-mm-dd HH:mm:ss") & "." & ((dt - Fix(dt)) * 1000)
    Dim decimalPart As Double
    decimalPart = Round(((dt - Fix(dt)) * 10), 0)
    If (decimalPart = 10) Then
        FormatDateEx = format(dt / 86400, formatPattern) & ".0"
    Else
        FormatDateEx = format(Fix(dt) / 86400, formatPattern) & "." & decimalPart
    End If
End Function

- Ted Kerley