Datetime VB6的一种较好的CDate

我们有一个VB6应用程序（在COM组件中），它使用CDate（）获取字符串并将其转换为日期，以便存储在数据库中

例如，根据我们是否希望应用程序以dd/MM/yy或MM/dd/yy进行通话，我们必须更改COM应用程序的标识用户的区域设置。（目前我们唯一的选择是。）

我们有一个日期格式字符串，用于格式化所有输出日期，并且假设日期

---

如果这是.NET，我们就会使用它，然后大笑起来。仅出于此目的调用.NET中编写的COM对象是一种选择。是否有一个不同或更好的选项，包括Format命令周围的一些黑魔法，或者一个长的可重用函数，根据格式字符串标记日期，等等？

您应该使用日期变量（而不是格式化字符串）进行对话然后使用用户区域设置在表单中显示格式化值，或者将用户输入的数据转换为日期变量。

我不知道有什么简单的解决方案。您可以通过分隔符将输入字符串转换为子字符串，然后使用将年、月和小时数重新组合为本机VB6变量。下面是这样的。如果您需要支持许多地区，这可能会变得复杂（请参阅）。请注意，使用DateTime.ParseExact也是如此

sInput = "1/3/71"
Dim splt() As String
splt = Split(sInput, "/")
dte = DateSerial(splt(2) + 1900, splt(1), splt(0))  ' dd/mm/yy'

---

您可以使用内置的

格式

功能来完成此操作

下面是一个简单的测试来确认这一点：

Public Sub TestDateParsing()

   'On my computer, the date format is U.S. (mm/dd/yyyy)'
   'This test creates a date string in dd/mm/yyyy format to'
   'simulate user input in a different format'

    Const TEST_DATE As Date = #6/1/2009#

    Dim inputDate As String
    inputDate = Format(TEST_DATE, "dd/mm/yyyy")
    'inputDate is "1/6/2009" (June 1 in dd/mm/yyyy format)'

    Debug.Print Format(inputDate, "dd/mm/yyyy")
    'It`s magic! The above line will print 6/1/2009'
    'which is the correct format for my Regional Settings'

End Sub

这可能看起来像魔术，但事实并非如此。它利用了

格式

功能与当前区域设置的协同工作方式

例如，假设您的区域设置配置为使用日期的

“mm/dd/yyyy”

格式

现在，您可以从用户处获得一个日期字符串，格式为

“dd/mm/yyyy”

。如果

格式化

此日期字符串，并告诉

格式化

同时使用

“dd/mm/yyyy”

，它将交换日期的月和日部分，因为您的设置显示日期为

“mm/dd/yyyy”

格式

换句话说，

格式

始终假定用户的日期字符串是根据您当前的区域设置格式化的（在本例中，

“mm/dd/yyyyy”

），因此当您告诉它使用

“dd/mm/yyyyy”

格式化日期时，它将强制交换月和日部分。如果您的区域设置使用与用户提供的日期相同的格式，则此代码仍然有效：

format

将简单地返回用户日期不变。困惑了吗？；）

如果您的区域设置设置为“dd/mm/yyyyy”，并且用户以

“mm/dd/yyyy”

格式发送日期，也会发生同样的情况

关键是你必须提前知道用户发送日期的格式。他们不能开始混合和匹配日期格式（而且无论如何也不应该如此）

---

编辑（按MarkJ）-只是为了证明Mike的代码可以将字符串转换为日期。迈克，如果你愿意，请回滚或更改此编辑

Public Sub Test()
  Dim dte As Date
  For dte = #1/1/2009# To #12/31/2009#
    Call TestDateParsing(dte)
  Next dte
End Sub

Public Sub TestDateParsing(ByVal dteIn As Date)

  'On my computer, the date format is U.S. (mm/dd/yyyy)'
  'This test creates a date string in dd/mm/yyyy format to'
  'simulate user input in a different format'

  Dim sExpected As String
  sExpected = Day(dteIn) & " / " & Month(dteIn) & " / " & Year(dteIn)
  Dim inputDate As String
  Dim dte As Date
  inputDate = Format(dteIn, "dd/mm/yyyy")
  dte = Format(inputDate, "dd/mm/yyyy")

  Debug.Assert sExpected = Day(dte) & " / " & Month(dte) & " / " & Year(dte)
  Debug.Print sExpected

End Sub

---

听着，说这句话不容易——你完蛋了。如果你接受来自网络的自由形式的输入，你必须接受世界各地的人们日期格式不同的现实。这就是为什么如此多的网站使用弹出式日历等来获取用户输入。没有模棱两可之处。无论您怎么想，.NET的库例程都无法比任何其他库更好地理解用户的意图

Fwiw，Mike发布的代码绝对是VB6。我不确定它看起来像VB.NET吗？在日期变量中输入日期/时间后，可以使用Format（）以任何方式显示它。这是最简单的部分

---

我强烈建议你要么A）找到一种方法，毫不含糊地收集你的输入，要么B）告诉你的用户你期望什么格式，并接受他们输入的内容。尽管如此，我是否可能误解了这个问题，而您确实知道用户提供数据的格式是什么？（因为如果是这样的话，我真的很难理解在ClassicVB中解释它的问题所在-对不起。）

您在评论中提到了您正在从web获取输入的其他答案之一

在这种情况下，您可以通过将用户输入限制为下拉列表来控制提交的日期格式。在月份框中列出短月份或长月份名称1月/1月/2月/2月等，然后以“2009年1月1日”格式构造一个日期字符串

---

然后，无论您的区域设置是什么，您都可以得到用户想要的日期。

这应该很接近，尽管它将分隔符硬编码为“/”，windows YY年为50年：

Private Function ParseDate(ByVal DateString As String, _
                           ByVal DatePattern As String) As Date
    'DateString:  i/j/k formatting.
    'DatePattern: i/j/k formatting, each to be:
    '               M or MM for month position.
    '               D or DD for day position.
    '               YY or YYYY for year position, if YY
    '                 then century windowed at 50.
    Dim strStringParts() As String
    Dim strPatternParts() As String
    Dim intPart As Integer, intScore As Integer
    Dim intMonth As Integer, intDay As Integer, intYear As Integer
    Const DELIM As String = "/"
    Const YYWINDOW As Integer = 50

    strStringParts = Split(DateString, DELIM)
    strPatternParts = Split(UCase$(DatePattern), DELIM)
    For intPart = 0 To UBound(strStringParts)
        If intPart > UBound(strPatternParts) Then
            Err.Raise 5, "ParseDate"
        End If
        Select Case strPatternParts(intPart)
            Case "M", "MM"
                intMonth = CInt(strStringParts(intPart))
                intScore = intScore Or &H1
            Case "D", "DD"
                intDay = CInt(strStringParts(intPart))
                intScore = intScore Or &H2
            Case "YY"
                intYear = CInt(strStringParts(intPart))
                If 0 > intYear Or intYear > 99 Then
                    Err.Raise 5, "ParseDate"
                End If
                intYear = intYear + IIf(intYear < YYWINDOW, 2000, 1900)
                intScore = intScore Or &H4
            Case "YYYY"
                intYear = CInt(strStringParts(intPart))
                If 100 > intYear Or intYear > 9999 Then
                    Err.Raise 5, "ParseDate"
                End If
                intScore = intScore Or &H4
            Case Else
                Err.Raise 5, "ParseDate"
        End Select
    Next
    If intScore = &H7 Then
        ParseDate = DateSerial(intYear, intMonth, intDay)
    Else
        Err.Raise 5, "ParseDate"
    End If
End Function

私有函数ParseDate（ByVal DateString作为字符串_
ByVal DatePattern（作为字符串）作为日期
'日期字符串：i/j/k格式。
'DatePattern:i/j/k格式，每个格式应为：
“M或MM表示月份位置。
D或DD表示白天的位置。
'YY或YYYY表示年份位置，如果YY
然后，世纪银行在50岁时开窗。
将strStringParts（）设置为字符串
将strPatternParts（）设置为字符串
Dim intPart为整数，intScore为整数
Dim intMonth为整数，intDay为整数，intYear为整数
Const DELIM As String=“/”
常量YYWINDOW为整数=50
strStringParts=Split（日期字符串，DELIM）
strPatternParts=Split（UCase$（DatePattern），DELIM）
对于intPart=0到UBound（strStringParts）
如果intPart>UBound（strPatternParts），则
错误。提高5，“解析日期”
如果结束
选择案例strPatternParts（intPart）
案例“M”、“MM”
intMonth=CInt（strStringParts（intPart））
intScore=intScore或&H1
案例“D”、“DD”
intDay=CInt（strStringParts（intPart））
intScore=intScore或&H2
案例“YY”
intYear=CInt（strStringParts（intPart））
Public Enum abDateType
    abMDY
    abDMY
End Enum

Public Function MakeDate(ByVal dateString As String, ByVal dateType As abDateType, Optional delimiter As String = "/") As Date
    Dim strVals() As String
    Dim dtRtnVal As Date
    strVals = Split(dateString, delimiter)
    Select Case dateType
    Case abMDY
        dtRtnVal = DateSerial(strVals(2), strVals(0), strVals(1))
    Case abDMY
        dtRtnVal = DateSerial(strVals(2), strVals(1), strVals(0))
    Case Else
        Err.Raise vbObjectError, , "Unexpected date format."
    End Select
    MakeDate = dtRtnVal
End Function

ThisLine =  "Tuesday, September 04, 2012 2:02 PM"

i = InStr(ThisLine, ",")  ' get rid of the leading day

If i > 0 Then
     TempResult = Trim(Right$(ThisLine, Len(ThisLine) - i))
end if

TempResult = DateAdd("s", 0, TempResult)