Esto debería funcionar:
Function UTF8Filter(strString)
On Error Resume Next
For i = 1 to Len(strString)
charCode = AscW(Mid(strString, i, 1))
If charCode > 32 AND charCode <= 127 then ' here was OR
'Append valid character'
strString = Mid(strString, i, 1)
End If
Next
UTF8Filter = strString
On Error Goto 0
End Function
Función actualizada:
Function Remove4ByteUFT8(strString)
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = "/[\xF0-\xF7].../s"
Remove4ByteUFT8 = objRegEx.Replace(strString, "")
End Function