Option Explicit
Private Sub Text1_KeyPress(KeyAscii As Integer)
On Error GoTo Text1_KeyPress_Error
If (KeyAscii = 45) Or (KeyAscii = 46) Or (KeyAscii = 92) Then
'45 = -
'46 = .
'92 = \
KeyAscii = 47 ' /
ElseIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then ' Allows only Numbers
KeyAscii = 0
End If
On Error GoTo 0
Exit Sub
Text1_KeyPress_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Text1_KeyPress of " & Me.Name
End Sub
Private Sub Text1_LostFocus()
On Error GoTo Text1_LostFocus_Error
Dim strDateText As String
strDateText = Me.Text1.Text
If strDateText & "" = "" Then ' Check for a Null, or Empty String Values
Exit Sub
Else
strDateText = FormatDate(strDateText)
If strDateText = "Invalid Entry" Then
'Display Error in Messagebox
MsgBox "You Have entered an invalid date (" & Me.Text1.Text & ") , Please re-enter", vbInformation, "Invalid Date"
Me.Text1.Text = "" ' Clears textbox
Me.Text1.SetFocus 'Sets thje focus back to the textbox
Else
Me.Text1.Text = strDateText
End If
End If
On Error GoTo 0
Exit Sub
Text1_LostFocus_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Text1_LostFocus of " & Me.Name
End Sub
Private Function FormatDate(strDate As String) As String
On Error GoTo FormatDate_Error
Dim strDateText As String
If IsDate(strDate) Then ' Checks if strDate contain a valid date,
'if so formats it MM/DD/YYYY
FormatDate = Format(strDate, "mm/dd/yyyy")
Exit Function
Else
If IsNumeric(strDate) Then
Select Case Len(strDate)
Case 6 'Checks if numbers were in the following format: 123102
strDateText = Left(strDate, 2) & "/"
strDateText = strDateText & Mid(strDate, 3, 2) & "/"
strDateText = strDateText & Mid(strDate, 5, 2)
Case 8 'Checks if numbers were in the following format: 12312002
strDateText = Left(strDate, 2) & "/"
strDateText = strDateText & Mid(strDate, 3, 2) & "/"
strDateText = strDateText & Mid(strDate, 5, 4)
Case Else 'If it isn't in one of the above formats return an invalid entry entry
strDateText = "Invalid Entry"
End Select
Else
strDateText = "Invalid Entry"
End If
If IsDate(strDateText) Then 'Checks to make sure dates like
'88/65/2002 are not returned
FormatDate = Format(strDateText, "mm/dd/yyyy")
Else
FormatDate = "Invalid Entry"
End If
End If
On Error GoTo 0
Exit Function
FormatDate_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatDate of " & Me.Name
End Function