Обработка строк в каталогах картин

Function sArtX(ByVal sL As String) As String
  ' sArtX - поиск в строке "Х" и "х" и замена на латинское "x".
  Dim sT As String
  Dim sNum As String
  Dim sCB As String
  Dim sCE As String
  Dim lLen As Long
  Dim lPos As Long
  Dim lStart As Long
  '
  If "" = sL Then
    ' Пустая строка - искать нечего.
    sArtX = ""
    Exit Function
  End If
  sT = LCase$(sL)
  If 0 = InStr(sT, "х") And 0 = InStr(sT, "x") Then
    ' Символы "Х" и "х" в строке не обнаружен.
    sArtX = sL
    Exit Function
  End If
  sNum = "0123456789"
  sT = sL
  lLen = Len(sT)
  lStart = 1
  Do While True
    ' Замена латинской буквы X
    lPos = InStr(lStart, sT, "X")
    If 0 = lPos Then
      Exit Do
    ElseIf 1 = lPos Then
      ' Первая позиция - анализировать нечего - начинаем поиск со следующего символа
      lStart = lPos + 1
    ElseIf lLen = lPos Then
      ' Последняя позиция - анализировать нечего - выходим из цикла
      Exit Do
    Else
      sCB = Mid$(sT, lPos - 1, 1)
      sCE = Mid$(sT, lPos + 1, 1)
      If 0 <> InStr(sNum, sCB) And 0 <> InStr(sNum, sCE) Then
        Mid$(sT, lPos) = "x"
        lStart = lPos + 1
      Else
        lStart = lPos + 1
      End If
    End If
  Loop
  lStart = 1
  Do While True
    ' Замена русской буквы Х
    lPos = InStr(lStart, sT, "Х")
    If 0 = lPos Then
      Exit Do
    ElseIf 1 = lPos Then
      ' Первая позиция - анализировать нечего - начинаем поиск со следующего символа
      lStart = lPos + 1
    ElseIf lLen = lPos Then
      ' Последняя позиция - анализировать нечего - выходим из цикла
      Exit Do
    Else
      sCB = Mid$(sT, lPos - 1, 1)
      sCE = Mid$(sT, lPos + 1, 1)
      If 0 <> InStr(sNum, sCB) And 0 <> InStr(sNum, sCE) Then
        Mid$(sT, lPos) = "x"
        lStart = lPos + 1
      Else
        lStart = lPos + 1
      End If
    End If
  Loop
  lStart = 1
  Do While True
    ' Замена русской буквы х
    lPos = InStr(lStart, sT, "х")
    If 0 = lPos Then
      Exit Do
    ElseIf 1 = lPos Then
      ' Первая позиция - анализировать нечего - начинаем поиск со следующего символа
      lStart = lPos + 1
    ElseIf lLen = lPos Then
      ' Последняя позиция - анализировать нечего - выходим из цикла
      Exit Do
    Else
      sCB = Mid$(sT, lPos - 1, 1)
      sCE = Mid$(sT, lPos + 1, 1)
      If 0 <> InStr(sNum, sCB) And 0 <> InStr(sNum, sCE) Then
        Mid$(sT, lPos) = "x"
        lStart = lPos + 1
      Else
        lStart = lPos + 1
      End If
    End If
  Loop
  sArtX = sT
End Function

Function sArtX1(sL As String) As String
Static re As Object
  If re Is Nothing Then
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "(\d) *[XХх] *(\d)"
  End If
  sArtX1 = re.Replace(sL, "$1x$2")
End Function