ConvertAccent

Function ConvertAccent(ByVal inputString As String) As String
' http://www.vbforums.com/archive/index.php/t-483965.html
 
Const AccChars As String = _
    "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars As String = _
    "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
 
Dim i As Long, j As Long
Dim tempString As String
Dim currentCharacter As String
Dim found As Boolean
Dim foundPosition As Long
 
  tempString = inputString
 
  ' loop through the shorter string
 Select Case True
    Case Len(AccChars) <= Len(inputString)
      ' accent character list is shorter (or same)
     ' loop through accent character string
     For i = 1 To Len(AccChars)
 
        ' get next accent character
       currentCharacter = Mid$(AccChars, i, 1)
 
        ' replace with corresponding character in "regular" array
       If InStr(tempString, currentCharacter) > 0 Then
          tempString = Replace(tempString, currentCharacter, Mid$(RegChars, i, 1))
        End If
 
      Next i
    Case Len(AccChars) > Len(inputString)
      ' input string is shorter
     ' loop through input string
     For i = 1 To Len(inputString)
 
        ' grab current character from input string and
       ' determine if it is a special char
       currentCharacter = Mid$(inputString, i, 1)
        found = (InStr(AccChars, currentCharacter) > 0)
 
        If found Then
 
          ' find position of special character in special array
         foundPosition = InStr(AccChars, currentCharacter)
 
          ' replace with corresponding character in "regular" array
         tempString = Replace(tempString, currentCharacter, _
    Mid$(RegChars, foundPosition, 1))
 
        End If
      Next i
  End Select
 
  ConvertAccent = tempString
End Function