Accounting systems

Function SpecialReplace(ByVal tmpReg) As String
If Len(tmpReg) > 0 Then
    Dim tmpStr
    'start the replace
    'clear double spaces
    tmpStr = Trim(tmpReg)
    tmpStr = FindAndReplace(tmpStr, "ä", "a") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "Ä", "A") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "é", "e") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "ö", "o") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "Ö", "O") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "ü", "u") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "Ü", "U") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "ß", "s") ' ) bracket
    tmpStr = FindAndReplace(tmpStr, "Å", "A")
    tmpStr = FindAndReplace(tmpStr, "å", "a")
    tmpStr = FindAndReplace(tmpStr, "Æ", "A")
    tmpStr = FindAndReplace(tmpStr, "æ", "a")
    tmpStr = FindAndReplace(tmpStr, "Ø", "O")
    SpecialReplace = tmpStr
End If
End Function

''************ Code Start **********
'This code was originally written by Alden Streeter.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Alden Streeter
'
Function FindAndReplace(ByVal strInString As String, strFindString As String, strReplaceString As String) As String
Dim intPtr As Integer
    If Len(strFindString) > 0 Then  'catch if try to find empty string
        Do
            intPtr = InStr(strInString, strFindString)
            If intPtr > 0 Then
                FindAndReplace = FindAndReplace & Left(strInString, intPtr - 1) & strReplaceString
                    strInString = Mid(strInString, intPtr + Len(strFindString))
            End If
        Loop While intPtr > 0
    End If
    FindAndReplace = FindAndReplace & strInString
End Function