vb.net транслитерация для заполнения AD атрибута "simpledisplayname" из атрибута "displayname"

Imports System.DirectoryServices

Module Module1
    Sub Main()
        Dim De As New DirectoryEntry("LDAP://OU=Personal,OU=**,....,DC=**,DC=**")
        Dim DS As New DirectorySearcher(De)
        DS.Filter = "(&(objectClass=user)(!objectClass=computer))"

        For Each sr As SearchResult In DS.FindAll
            If sr.Properties("displayName").Count > 0 Then
                Dim srD As DirectoryEntry = sr.GetDirectoryEntry
                Dim SimpleDisplayName As String = SetTranslit(DropSurname(sr.Properties("displayName")(0).ToString))
                srD.Properties("displayNamePrintable").Value = SetTranslit(DropSurname(sr.Properties("displayName")(0).ToString))
                srD.CommitChanges()
            End If
        Next
    End Sub

    Function SetTranslit(ByVal SourceT As String) As String

        Dim Source As String = SourceT

        Source = Source.Replace("а", "a")
        Source = Source.Replace("б", "b")
        Source = Source.Replace("в", "v")
        Source = Source.Replace("г", "g")
        Source = Source.Replace("д", "d")
        Source = Source.Replace("е", "e")
        Source = Source.Replace("ё", "yo")
        Source = Source.Replace("ж", "zh")
        Source = Source.Replace("з", "z")
        Source = Source.Replace("и", "i")
        Source = Source.Replace("й", "j")
        Source = Source.Replace("к", "k")
        Source = Source.Replace("л", "l")
        Source = Source.Replace("м", "m")
        Source = Source.Replace("н", "n")
        Source = Source.Replace("о", "o")
        Source = Source.Replace("п", "p")
        Source = Source.Replace("р", "r")
        Source = Source.Replace("с", "s")
        Source = Source.Replace("т", "t")
        Source = Source.Replace("у", "u")
        Source = Source.Replace("ф", "f")
        Source = Source.Replace("х", "kh")
        Source = Source.Replace("ц", "ts")
        Source = Source.Replace("ч", "ch")
        Source = Source.Replace("ш", "sh")
        Source = Source.Replace("щ", "shch")
        Source = Source.Replace("ы", "y")
        Source = Source.Replace("э", "a")
        Source = Source.Replace("ю", "yu")
        Source = Source.Replace("я", "ya")
        Source = Source.Replace("ь", "")
        Source = Source.Replace("ъ", "")

        Source = Source.Replace("А", "A")
        Source = Source.Replace("Б", "B")
        Source = Source.Replace("В", "V")
        Source = Source.Replace("Г", "G")
        Source = Source.Replace("Д", "D")
        Source = Source.Replace("Е", "E")
        Source = Source.Replace("Ё", "Yo")
        Source = Source.Replace("Ж", "Zh")
        Source = Source.Replace("З", "Z")
        Source = Source.Replace("И", "I")
        Source = Source.Replace("Й", "J")
        Source = Source.Replace("К", "K")
        Source = Source.Replace("Л", "L")
        Source = Source.Replace("М", "M")
        Source = Source.Replace("Н", "N")
        Source = Source.Replace("О", "O")
        Source = Source.Replace("П", "P")
        Source = Source.Replace("Р", "R")
        Source = Source.Replace("С", "S")
        Source = Source.Replace("Т", "T")
        Source = Source.Replace("У", "U")
        Source = Source.Replace("Ф", "F")
        Source = Source.Replace("Х", "Kh")
        Source = Source.Replace("Ц", "Ts")
        Source = Source.Replace("Ч", "Ch")
        Source = Source.Replace("Ш", "Sh")
        Source = Source.Replace("Щ", "Shch")
        Source = Source.Replace("Ы", "Y")
        Source = Source.Replace("Э", "A")
        Source = Source.Replace("Ю", "Yu")
        Source = Source.Replace("Я", "Ya")
        Source = Source.Replace("Ь", "")
        Source = Source.Replace("Ъ", "")
        Return Source
    End Function

    Function DropSurname(ByVal DisplayName) As String
        Dim NameS() = Split(DisplayName, " ")
        Dim Name = String.Empty
        Dim SurName = String.Empty
        Dim FamilyName = String.Empty
        Select Case NameS.Count
            Case 0
                FamilyName = DisplayName
            Case 1
                FamilyName = NameS(0)
            Case 2
                FamilyName = NameS(0)
                Name = NameS(1)
            Case Is >= 3
                FamilyName = NameS(0)
                Name = NameS(1)
                SurName = NameS(2)
        End Select
        Return FamilyName & " " & Name
    End Function
End Module