Определить название месяца выбранного дня

Option Explicit
 
Dim R, d, X
Dim s, n, res, i
 
R = array( _
      array("-", " тысяча", " тысячи", " тысяч"), _
      array("-", " сотня", " сотни", " сотен"), _
      array("+", " десяток", " десятка", " десятков"), _
      array("-", " единица", " единицы", " единиц"))
 
d = array("один","два","три","четыре","пять","шесть","семь","восемь","девять", "одна","две")
 
Do
  n = InputBox("Введите положительное число от 1 до 9999" & vbNewLine & _
    "Для завершения нажмите кнопку ""Ok""" & vbNewLine & _
    "или введите нецифровой символ")
  If Not IsNumeric(n) Then Exit Do
 
  s = CStr(n)
  res= ""
 
  i = 0                   ' индекс для первого измерения массива R
  If n <= 0 Or n > 9999 Then
    WScript.Echo "Введено недопустимое число"
  Else
    If n > 999 Then       ' четырехзначное число, индекс не меняем
    ElseIf n > 99 Then
      i = i + 1           ' трехзначное, пропустим нулевой элемент массива R - начнем с сотен
    ElseIf n > 9 Then
      i = i + 2           ' с десятков
    Else
      i = i + 3
    End If
 
    X = R(i)
 
    While Len(s) > 0
      X = R(i)
      n = CInt(left(s, 1))
      Select Case n
        Case 0                ' особый случай, ноль (сотен, десятков), удалим пробел добавленный оператором в строке 68
          If Right(res, 1) = " " Then res = Left(res, Len(res)-1)
        Case 1                ' для "1" - нужный род числительного
          If X(0) = "+" Then  ' плюс - ОН, в противном случае - ОНА
            res = res & d(n-1)
          Else
            res = res & d(9)
          End If
          res = res & X(1)
        Case 2,3,4
          If n = 2 Then     ' для "2" - аналогично "1"
            If X(0) = "+" Then
              res = res & d(n-1)
            Else
              res = res & d(10)
            End If
          Else
            res = res & d(n-1)
          End If
          res = res & X(2)
        Case Else
          res = res & d(n-1) & X(3)
      End Select
      i = i + 1
      s = Mid(s, 2)         ' отсечем обработанную цифру
      If Len(s) > 0 Then res = res & " "  ' еще цифры есть, добавим пробельчик чтобы не слипались остальные разряды
    Wend
    WScript.Echo res
  End If
Loop While IsNumeric(n)