The mask edit control still has some limitations. Here is some code that used for a text box a couple of years ago. I gives a basic mask for the user to follow and allows you to type through quickly Basic validation is done in the lost focus event and would probably be better in the validation event. If it helps use the code and /or make adjustments as you wish.
Option Explicit
Private m_intDateEntered As Integer
Private m_bolDateDirty As Boolean
Private Sub txtDate_Change()
m_bolDateDirty = True
End Sub
Private Sub txtDate_GotFocus()
m_intDateEntered = 0
m_bolDateDirty = False
End Sub
Private Sub txtDate_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Then ' numbers only
Select Case m_intDateEntered
Case 0
txtDate.Text = "mmddyy"
txtDate.SelStart = 0
txtDate.SelLength = 1
Case 1
txtDate.Text = Left(txtDate.Text, 1) & "mddyy"
txtDate.SelStart = 1
txtDate.SelLength = 1
Case 2
txtDate.Text = Left(txtDate.Text, 2) & "ddyy"
txtDate.SelStart = 2
txtDate.SelLength = 1
Case 3
txtDate.Text = Left(txtDate.Text, 3) & "dyy"
txtDate.SelStart = 3
txtDate.SelLength = 1
Case 4
txtDate.Text = Left(txtDate.Text, 4) & "yy"
txtDate.SelStart = 4
txtDate.SelLength = 1
Case 5
txtDate.Text = Left(txtDate.Text, 5) & "y"
txtDate.SelStart = 5
txtDate.SelLength = 1
Case 6
'// Do nothing.
End Select
m_intDateEntered = m_intDateEntered + 1
ElseIf KeyAscii = 8 Then '// Backspace key.
m_intDateEntered = m_intDateEntered - 1
Select Case m_intDateEntered
Case 0
txtDate.Text = Left(txtDate.Text, 1) & "mmddyy"
txtDate.SelStart = 0
txtDate.SelLength = 1
Case 1
txtDate.Text = Left(txtDate.Text, 2) & "mddyy"
txtDate.SelStart = 1
txtDate.SelLength = 1
Case 2
txtDate.Text = Left(txtDate.Text, 3) & "ddyy"
txtDate.SelStart = 2
txtDate.SelLength = 1
Case 3
txtDate.Text = Left(txtDate.Text, 4) & "dyy"
txtDate.SelStart = 3
txtDate.SelLength = 1
Case 4
txtDate.Text = Left(txtDate.Text, 5) & "yy"
txtDate.SelStart = 4
txtDate.SelLength = 1
Case 5
txtDate.Text = Left(txtDate.Text, 6) & "y"
txtDate.SelStart = 5
txtDate.SelLength = 1
Case 6
'// Do nothing.
End Select
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub txtDate_LostFocus()
If m_bolDateDirty Then
If Valid_DateNumbers(txtDate.Text) Then
If Left(txtDate.Text, 1) = "0" Then
txtDate.Text = Right(txtDate.Text, Len(txtDate.Text) - 1)
txtDate.Text = Left(txtDate.Text, 1) & "/" & Mid(txtDate.Text, 2, 2) & "/" & Mid(txtDate.Text, 4, 2)
Else
txtDate.Text = Left(txtDate.Text, 2) & "/" & Mid(txtDate.Text, 3, 2) & "/" & Mid(txtDate.Text, 5, 2)
End If
Else
MsgBox "The date was entered incorrectly." & vbCrLf & "Re-enter the date in " & Chr(34) & "mmddyy" & Chr(34) & " format.", vbOKOnly + vbCritical, "Invalid Input"
txtDate.Text = "mmddyy"
txtDate.SetFocus
txtDate.SelStart = 0
txtDate.SelLength = Len(txtDate.Text)
End If
End If
End Sub
Private Function Valid_DateNumbers(Entry As String) As Boolean
'// Determines if the entered date values are within acceptable ranges.
Dim l_bolOK As Boolean, l_intMonth As Integer, l_intDay As Integer, l_intYear As Integer
l_bolOK = True
If Len(Entry) <> 6 Then
l_bolOK = False
GoTo BadEntry
End If
l_intMonth = Val(Left(Entry, 2))
l_intDay = Val(Mid(Entry, 3, 2))
l_intYear = Val(Right(Entry, 2))
If l_intMonth <= 0 Or l_intMonth > 12 Then
l_bolOK = False
GoTo BadEntry
End If
Select Case l_intMonth
Case 1, 3, 5, 7, 8, 10, 12
If l_intDay <= 0 Or l_intDay > 31 Then
l_bolOK = False
GoTo BadEntry
End If
Case 2
If Right(Entry, 2) = "00" Or l_intYear Mod 4 = 0 Then
If l_intDay <= 0 Or l_intDay > 29 Then
l_bolOK = False
GoTo BadEntry
End If
Else
If l_intDay <= 0 Or l_intDay > 28 Then
l_bolOK = False
GoTo BadEntry
End If
End If
Case 4, 6, 9, 11
If l_intDay <= 0 Or l_intDay > 30 Then
l_bolOK = False
GoTo BadEntry
End If
End Select
BadEntry:
Valid_DateNumbers = l_bolOK
End Function
Thanks and Good Luck!
zemp