Function Str2Date(strDate As String, Optional DtSep As String = "/", _
Optional DtOrder As String = "mdy") As Date
'Michael Red 1/25/2002
On Error GoTo Err_Str2Date
Dim strMan As Variant
Dim MyMnth As Integer
Dim MyDay As Integer
Dim MyYr As Integer
'This function returns a date if it can.
'The Optional DtSep arg allows the seperator symbol to be
'Set by the call, but defaults to the standard "/".
'The Optional DtOrder Argument allows the "m/d/y" order to
'be specified. If provided, it MUSY be a three char string
'of "m" and "d" and "y" in any order, however the seperate
'parts are then coerced to the respective datepart. The default
'("mdy") formats the date in the "US" format.
'The Date order is assumed to be m/d/y.
'If this doesn't work:
' "m" is > 12 or "d" < # days in month, we attempt to use d/m/y.
'If the d/m/y format doesn't work:
' "d" > # days in "m" or "m" > 12,
'we will attempt the y/m/d arrangement.
'If all of these fail, return the Error (Null)
strMan = Split(strDate, DtSep)
'Check that there are Three (and ONLY Three parts)
If (UBound(strMan) <> 2) Then
GoTo Err_Str2Date
End If
'Check that each part is an Integer
Do While Idx <= UBound(strMan)
'First, check that is is a number
If (IsNumeric(strMan(Idx))) Then
strMan(Idx) = Val(strMan(Idx))
Else
GoTo Err_Str2Date
End If
'Now Check it is An Integer
If (Int(strMan(Idx)) <> Val(strMan(Idx))) Then
GoTo Err_Str2Date
End If
Idx = Idx + 1
Loop
Idx = 1
Do While Idx <= Len(DtOrder)
Select Case Mid(UCase(DtOrder), Idx, 1)
Case Is = "M"
MyMnth = strMan(Idx - 1)
Case Is = "D"
MyDay = strMan(Idx - 1)
Case Is = "Y"
MyYr = strMan(Idx - 1)
End Select
Idx = Idx + 1
Loop
Str2Date = DateSerial(MyYr, MyMnth, MyDay)
Exit_Str2Date:
Exit Function
Err_Str2Date:
MsgBox Err.Description, , "Str2Date: " & Err.Number
Resume Exit_Str2Date
End Function