Транслитерация строки для использования в URL

Функция транслитерации текстовой строки для использования в URL с зачисткой от запрещённых символов и переводом в нижний регистр

Function TranslitForURL(val As Variant, Optional sZamena As String = "_") As String
' es - 13.12.2015
' VBA функция транслитерации текстовой строки для использования в URL
' с зачисткой от запрещённых символов и переводом в нижний регистр
'--------------------------------------------------------------------
' Возвращает модифицированную строку
' Аргументы:
'   val      = входящая строка (значение поля)
'   sZamena  = Символ замены для пробелов и проч. (по умолчанию = "_")
'--------------------------------------------------------------------
' Считается, что в URL адресе, допустимы_только латинские буквы, арабские цифры _
' и ограниченный набор знаков (-_.), а прочие знаки (!@#$&~%*()[]{}'\:;><`,)- недопустимы.
' Коды символов можно найти например тут:
' http://autoit-script.ru/autoit3_docs/appendix/ascii.htm
'--------------------------------------------------------------------
Dim strRussian As String
Dim arrTranslit As Variant
Dim iPos As Integer
Dim sTemp As String
Dim sResult As String
Dim str  As String

'--------------------------------------------------------------------
On Error GoTo TranslitForURL_Err
    
    str = CStr(val)

' Очистка строки - оставляем только приемлемые символы и переводим в нижний регистр
    For iPos = 1 To Len(str)
        sTemp = LCase(Mid(str, iPos, 1))
        Select Case Asc(sTemp)
            Case 32      'Пробел
                sResult = sResult & sTemp
            Case 45       'Дефис, минус (по желанию)
                If sZamena = "-" Then
                    sResult = sResult & sTemp
                Else ' Тут меняем на пробел
                    sResult = sResult & " "
                End If
            Case 48 To 57 'цыфири
                sResult = sResult & sTemp
            Case 65 To 90, 97 To 122, 192 To 255 'Буквы англ + рус
                sResult = sResult & sTemp
            Case 95 'Нижнее подчёркивание
                sResult = sResult & " "
                
            'Дальше по желанию
        End Select
        
    Next
    str = Trim(sResult)
    'Debug.Print str
    Do While InStr(1, str, Space(2), 1) <> 0  'Убираем (возможные) лишние пробелы
        str = Replace(str, Space(2), Space(1), vbTextCompare)
    Loop
    
'Собственно транлитирование -
    strRussian = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя "
    
'Произвольный массив для замены - И никаких апострофов!!!
    'arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "y", "k", _
           "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "h", "c", "ch", _
            "sh", "zch", "", "i", "", "eh", "ju", "ja", sZamena)
    
'Международный стандарт Doc 9303, рекомендованный ИКАО:
    arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "i", "k", _
           "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "tc", "ch", _
            "sh", "shch", "ie", "y", "", "e", "iu", "ia", sZamena)
    
    For iPos = 1 To 34
        str = Replace(str, Mid(strRussian, iPos, 1), arrTranslit(iPos), , , vbTextCompare) '

    Next
    TranslitForURL = str

TranslitForURL_Bye:
    Exit Function

TranslitForURL_Err:
    TranslitForURL = "! Err in string: " & str
    ' MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "в процедуре: TranslitForURL", vbCritical, "Error!"
    Resume TranslitForURL_Bye
End Function

Пример использования функции TranslitForURL:

Private Sub test_TranslitForURL()
'Пример эксплуатации функции TranslitForURL
'--------------------------------------------------------------------
Dim s1 As String
Dim s2 As String
Dim s3 As String
'Проверять функцию транслитирования лучше на длинной и сложной строке:

    s1 = "Считается, что в URL адресе, допустимы только "
    s2 = "латинские буквы, арабские цифры и ограниченный набор знаков (-_.), "
    s3 = "а прочие знаки (!@#$&~%*()[]{}'\;><`:,)- недопустимы."
    
    s1 = TranslitForURL(s1, "-") 'Вариаант с заменой "грязи" на "-" (дефис)
    s2 = TranslitForURL(s2, "-")
    s3 = TranslitForURL(s3, "_") 'Вариаант с заменой на ""_"" (нижнее подчёркивание):"

    Debug.Print s1
    Debug.Print s2
    Debug.Print s3
End Sub

Пример эксплуатации в Immediate Window (Ctrl+G) напишет:

schitaetsia-chto-v-url-adrese-dopustimy-tolko
latinskie-bukvy-arabskie-tcifry-i-ogranichennyi-nabor-znakov--
a_prochie_znaki_nedopustimy