Just create a new User Control and then paste this source code into it. You should name the control ucTextBoxDate.
'----------------------------------------------------------------------
'
' Module Name: ucTextBoxDate
' Written By: C&D Programming Corp.
' Create Date: 1/99
' Copyright: Copyright 1999 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Public Event BadDate()
Public DateFormat As String ' standard formatting string (see Format help for details)
Public DateSeparator As String ' in many countries this is a slash (/)
' This is a hack to figure out the correct date separator no matter where in the world
' this code is executed. We're sure there is a more "correct" way to do this.
' If anyone knows how, please let us know at feedback@codeoftheweek.com
Private Function DefaultDateSeparator() As String
Dim sDate As String
Dim x As Integer
Dim sChar As String
On Error GoTo Handler
DefaultDateSeparator = "/" ' this is the default if for some reason the
' below "hack" does not work
sDate = Format(Now, "Short Date")
For x = 1 To Len(sDate)
sChar = Mid$(sDate, x, 1)
If sChar < "0" Or sChar > "9" Then
DefaultDateSeparator = sChar
Exit For
End If
Next x
Exit Function
Handler:
Err.Raise Err.Number, "CharCount", Err.Description
End Function
Private Function CharCount(sData As String, sSearchData As String) As Long
Dim lPos As Long
Dim lLastPos As Long
Dim lCount As Long
On Error GoTo Handler
lPos = 0
lCount = 0
Do
lLastPos = lPos
lPos = InStr(lPos + 1, sData, sSearchData, vbBinaryCompare)
If lPos = 0 Then Exit Do
lCount = lCount + 1
Loop
CharCount = lCount
Exit Function
Handler:
Err.Raise Err.Number, "CharCount", Err.Description
End Function
Private Sub txtDate_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Then
Exit Sub
End If
If KeyAscii = Asc(DateSeparator) Then ' 47 = Slash
' only allow max two date seps
If CharCount(txtDate.Text, DateSeparator) <> 2 Then
Exit Sub
End If
End If
' if we get here then we have an invalid key
KeyAscii = 0
End Sub
Private Sub UserControl_Initialize()
DateFormat = "Short Date"
DateSeparator = DefaultDateSeparator
End Sub
Private Sub UserControl_Resize()
txtDate.Top = 0
txtDate.Left = 0
txtDate.Width = UserControl.Width
txtDate.Height = UserControl.Height
End Sub
Public Function Validate() As Boolean
Dim sDate As String
Validate = False
sDate = txtDate.Text
' if they entered all six digits and no date separators then format it automatically for them.
If Len(sDate) = 6 And InStr(sDate, DateSeparator) = 0 Then
txtDate.Text = Left$(sDate, 2) & DateSeparator & Mid$(sDate, 3, 2) & DateSeparator & Right$(sDate, 2)
End If
If Not IsDate(txtDate.Text) Then
RaiseEvent BadDate
Else
txtDate.Text = Format(txtDate.Text, DateFormat)
End If
Validate = True
End Function
Public Property Get Text() As String
Text = Format(txtDate.Text, DateFormat)
End Property
Public Property Let Text(sText As String)
txtDate.Text = Text
End Property