help to test a code

Hello, I would like to verify that this code works well in any configuration, especially in the US, what the code does is to be able to change the date in a textbox with the up and down arrows, depending on where the cursor is positioned, it would change the day/month/year, here in South America we use the dd/mm/yy format but I understand that in other countries that order can change, for example in the US they use mm/dd/yy

just add a textbox to a form with the following code and with the keyboard arrows up down change the date and let me know if there is something strange. Thank you.

Code:

---

Option Explicit
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Const LOCALE_SDATE = &H1D
Const LOCALE_SSHORTDATE = &H1F

Dim sDateDiv As String
Dim sShortDate As String

Private Sub Form_Load()
    sDateDiv = fGetLocaleInfo(LOCALE_SDATE)
    sShortDate = fGetLocaleInfo(LOCALE_SSHORTDATE)
    Text1.Text = Format$(Date, sShortDate)
End Sub


Private Function fGetLocaleInfo(Valor As Long) As String
  Dim Simbolo As String
  Dim r1 As Long
  Dim r2 As Long
  Dim p As Integer
  Dim Locale As Long
   
  Locale = GetUserDefaultLCID()
  r1 = GetLocaleInfo(Locale, Valor, vbNullString, 0)
  Simbolo = String$(r1, 0)
  r2 = GetLocaleInfo(Locale, Valor, Simbolo, r1)
  p = InStr(Simbolo, Chr$(0))
   
  If p > 0 Then fGetLocaleInfo = Left$(Simbolo, p - 1)
 
   
End Function

Private Sub Text1_GotFocus()
    AutoSelDatePart
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  'On Error Resume Next
    Dim Val As Long
    Dim Sel As Long
    Dim TheDate As Date
    Dim Part1() As String
    Dim Part2() As String
    Dim i As Long
   
    If KeyCode = vbKeyUp Then
      Val = 1
      KeyCode = 0
    ElseIf KeyCode = vbKeyDown Then
      Val = -1
      KeyCode = 0
    ElseIf (KeyCode = vbKeyLeft) Then
        KeyCode = 0
        If Text1.SelStart > 0 Then Text1.SelStart = Text1.SelStart - 2
        AutoSelDatePart
        Exit Sub
    ElseIf KeyCode = vbKeyRight Then
        KeyCode = 0
        Text1.SelStart = Text1.SelStart + Text1.SelLength + 1
        AutoSelDatePart
        Exit Sub
     
    Else
      Exit Sub
    End If
   
    Part1 = Split(Text1.Text, sDateDiv)
    Part2 = Split(sShortDate, sDateDiv)
    For i = 0 To UBound(Part2)
        If InStr(LCase(Part2(i)), "y") Then Part2(i) = "yyyy"
    Next
    Sel = Text1.SelStart
    Select Case Text1.SelStart
      Case Is < Len(Part1(0)) + 1
          TheDate = DateAdd(Part2(0), Val, Text1.Text)
      Case Is < Len(Part1(0) & Part1(1)) + 2
          TheDate = DateAdd(Part2(1), Val, Text1.Text)
      Case Else
          TheDate = DateAdd("yyyy", Val, Text1.Text)
    End Select
    Text1.Text = Format$(TheDate, sShortDate)
    Text1.SelStart = Sel
    AutoSelDatePart
End Sub

Private Sub AutoSelDatePart()
    Dim Sel As Long
    Dim Part1() As String
   
    If Len(Text1.Text) < Len(sShortDate) Then Exit Sub
   
    Part1 = Split(Text1.Text, sDateDiv)
   
    Sel = Text1.SelStart

    Select Case Sel
        Case Is < Len(Part1(0)) + 1
            Text1.SelStart = 0
            Text1.SelLength = Len(Part1(0))
        Case Is < Len(Part1(0) & Part1(1)) + 2
            Text1.SelStart = Len(Part1(0)) + 1
            Text1.SelLength = Len(Part1(1))
        Case Else
            If UBound(Part1) < 2 Then
                Text1.SelStart = 0
                Text1.SelLength = Len(Part1(0))
            Else
                Text1.SelStart = Len(Text1.Text) - Len(Part1(2))
                Text1.SelLength = Len(Part1(2))
            End If
    End Select
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    AutoSelDatePart
End Sub

---

The code snippet was a bit messed up - looks like it was partially copied & pasted after the first bit, so I just tried the top-half of the code. It failed to work with dd/mm/yyyy short date format. After pressing up or down, the date changed to 30/12/1899.

I just tried this code and it worked OK (no error handling or anything though):

Code:

---

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim Val As Long
   
    If KeyCode = vbKeyUp Then
      Val = 1
      KeyCode = 0
    ElseIf KeyCode = vbKeyDown Then
      Val = -1
      KeyCode = 0
    Else
      Exit Sub
    End If
   
    Me.Text1.Text = Format$(DateAdd("d", Val, CDate(Me.Text1.Text)), "Short Date")
End Sub

---

Thanks for your time, there I have corrected part of the code and some changes, if someone else can try it I would appreciate it

Now it gets "Invalid Procedure Call or Argument" here:

Code:

---

TheDate = DateAdd(Part2(0), Val, Text1.Text)

---

Part2(0) = "dd" which is not legal. Should just be "d"