Option Explicit
'---------------------------
'Replacement IsDate function
'---------------------------
'Visual Basic's IsDate function falsely returns values such as 1.7 as true.
'This function resolves this issue.
Public Function ReplacementIsDate(ByVal sPotentialDate As String) As Boolean
Dim varSplit As Variant
Dim bValidDay As Boolean
Dim bValidMonth As Boolean
Dim bValidYear As Boolean
Dim iStep As Integer
ReplacementIsDate = False
varSplit = Split("Blank-Blank", "-")
If InStr(1, sPotentialDate, "\", vbTextCompare) > 0 Then
varSplit = Split(sPotentialDate, "\")
End If
If InStr(1, sPotentialDate, "/", vbTextCompare) > 0 Then
varSplit = Split(sPotentialDate, "/")
End If
If InStr(1, sPotentialDate, "-", vbTextCompare) > 0 Then
varSplit = Split(sPotentialDate, "-")
End If
If UBound(varSplit) = 2 Then
'Validate Year
If IsNumeric(varSplit(2)) = True Then
If (CInt(varSplit(2)) < 3000) And (CInt(varSplit(2)) > 0) Then
bValidYear = True
End If
End If
'Check for text month
'Exit function if both of the first two parts of the array are text
'i.e. May-May-2003
If (IsNumeric(varSplit(0)) = False) And (IsNumeric(varSplit(1)) = False) Then
Exit Function
End If
'i.e. 31-12-2003
'If both day and month are numeric...
If (IsNumeric(varSplit(0)) = True) And (IsNumeric(varSplit(1)) = True) Then
'assuming the first part of the array is the month and the second the day...
If CInt(varSplit(0)) < 32 And CInt(varSplit(0)) > 0 Then
If CInt(varSplit(1)) < 13 And CInt(varSplit(1)) > 0 Then
bValidDay = True
bValidMonth = True
End If
End If
'assuming the first part of the array is the day and the second the month...
If CInt(varSplit(0)) < 13 And CInt(varSplit(0)) > 0 Then
If CInt(varSplit(1)) < 32 And CInt(varSplit(1)) > 0 Then
bValidDay = True
bValidMonth = True
End If
End If
End If
'i.e. Jan/5/2003
'If the first part of the array is text then
If IsNumeric(varSplit(0)) = False Then
'If the first part of the array is a valid month then
If IsTextMonth(CStr(varSplit(0))) = True Then
If CInt(varSplit(1)) < 32 And CInt(varSplit(1)) > 0 Then
bValidDay = True
bValidMonth = True
End If
End If
End If
'i.e. 29-May-1977
'If the second part of the array is text then
If IsNumeric(varSplit(1)) = False Then
'If the second part of the array is a valid month then
If IsTextMonth(CStr(varSplit(1))) = True Then
If CInt(varSplit(0)) < 32 And CInt(varSplit(0)) > 0 Then
bValidDay = True
bValidMonth = True
End If
End If
End If
End If
If (bValidDay = True) And (bValidMonth = True) And (bValidYear = True) Then
ReplacementIsDate = True
End If
End Function
Public Function IsTextMonth(ByVal sPotentialMonth As String) As Boolean
Dim bytStep As Byte
Dim sCurrentMonth As String
sPotentialMonth = Trim(sPotentialMonth)
For bytStep = 1 To 12
sCurrentMonth = Format("28-" & bytStep & "-2000", "mmm")
If UCase(sCurrentMonth) = UCase(sPotentialMonth) Then
IsTextMonth = True
bytStep = 12
End If
Next bytStep
For bytStep = 1 To 12
sCurrentMonth = Format("28-" & bytStep & "-2000", "mmmm")
If UCase(sCurrentMonth) = UCase(sPotentialMonth) Then
IsTextMonth = True
bytStep = 12
End If
Next bytStep
End Function
