Strip Post

The following code strips html from text. Any ideas how i could change the code so it will strip some html and not others eg remove <font> tag but leave <br> tags.

------------------------------------------------------------ -------

Private Function removeHTML(ByVal strMessageInput)

 Dim lngMessagePosition  
 Dim intHTMLTagLength  
 Dim strHTMLMessage  
 Dim strTempMessageInput  

 
 strTempMessageInput = strMessageInput

For lngMessagePosition = 1 to CLng(Len(strMessageInput))

 If Mid(strMessageInput, lngMessagePosition, 1) = "" Then Exit For
  
    If Mid(strMessageInput, lngMessagePosition, 1) = "<" Then

   
   intHTMLTagLength = (InStr(lngMessagePosition, strMessageInput, ">", 1) - lngMessagePosition)
   
      If intHTMLTagLength < 0 Then intHTMLTagLength = CLng(Len(strTempMessageInput))

      strHTMLMessage = Mid(strMessageInput, lngMessagePosition, intHTMLTagLength + 1)

   
   strTempMessageInput = Replace(strTempMessageInput, strHTMLMessage, "", 1, -1, 0)
   
  End If
 Next
 
 'Replace a few characters in the remaining text
 strTempMessageInput = Replace(strTempMessageInput, "<", "&lt;", 1, -1, 1)
 strTempMessageInput = Replace(strTempMessageInput, ">", "&gt;", 1, -1, 1)
 strTempMessageInput = Replace(strTempMessageInput, "'", "", 1, -1, 1)
 strTempMessageInput = Replace(strTempMessageInput, """", "&#034;", 1, -1, 1)
 strTempMessageInput = Replace(strTempMessageInput, "&nbsp;", " ", 1, -1, 1)
         strTempMessageInput = Replace(strTempMessageInput, "’", "", 1, -1, 1)
         strTempMessageInput = Replace(strTempMessageInput, "^", "", 1, -1, 1)
         strTempMessageInput = Replace(strTempMessageInput, "~", "", 1, -1, 1)
 strTempMessageInput = Replace(strTempMessageInput, "€", "", 1, -1, 1)
 
 'Return the function
 removeHTML = strTempMessageInput
End Function

------------------------------------------------------------ -------