VB - Kills Html Tags

Printable View

VB Code:

Public Function KillHTML(ByVal strIn As String) As String
  Dim lngLen As Long, lngFound As Long, lngEnd As Long
  Dim strLeft As String, strRight As String
  strIn$ = Replace(strIn$, "<HTML>", "")
  strIn$ = Replace(strIn$, "</HTML>", "")
  strIn$ = Replace(strIn$, "<SUP>", "")
  strIn$ = Replace(strIn$, "</SUP>", "")
  strIn$ = Replace(strIn$, "<HR>", "")
  strIn$ = Replace(strIn$, "<H1>", "")
  strIn$ = Replace(strIn$, "<H2>", "")
  strIn$ = Replace(strIn$, "<H3>", "")
  strIn$ = Replace(strIn$, "<PRE>", "")
  strIn$ = Replace(strIn$, "</PRE>", "")
  strIn$ = Replace(strIn$, "<PRE=", "")
  strIn$ = Replace(strIn$, "<B>", "")
  strIn$ = Replace(strIn$, "</B>", "")
  strIn$ = Replace(strIn$, "<U>", "")
  strIn$ = Replace(strIn$, "</U>", "")
  strIn$ = Replace(strIn$, "<I>", "")
  strIn$ = Replace(strIn$, "</I>", "")
  strIn$ = Replace(strIn$, "<FONT>", "")
  strIn$ = Replace(strIn$, "</FONT>", "")
  strIn$ = Replace(strIn$, "<BODY>", "")
  strIn$ = Replace(strIn$, "</BODY>", "")
  strIn$ = Replace(strIn$, "<BR>", "")
  strIn$ = Replace(strIn$, "</A>", "")
  lngLen& = Len(strIn$)
  lngFound& = InStr(strIn$, "<BODY ")
  Do While lngFound& <> 0
    lngEnd& = InStr(lngFound&, strIn$, ">")
    If lngEnd& <> 0 Then
      strLeft$ = Left(strIn$, lngFound& - 1)
      strRight$ = Right(strIn$, lngLen& - lngEnd&)
      strIn$ = strLeft$ & strRight$
      lngLen& = Len(strIn$)
    End If
    lngFound& = InStr(lngFound& + 1, strIn$, "<BODY ")
  Loop
  lngFound& = InStr(strIn$, "<A ")
  Do While lngFound& <> 0
    lngEnd& = InStr(lngFound&, strIn$, ">")
    If lngEnd& <> 0 Then
      strLeft$ = Left(strIn$, lngFound& - 1)
      strRight$ = Right(strIn$, lngLen& - lngEnd&)
      strIn$ = strLeft$ & strRight$
      lngLen& = Len(strIn$)
    End If
    lngFound& = InStr(lngFound& + 1, strIn$, "<A ")
  Loop
  lngFound& = InStr(strIn$, "<FONT ")
  Do While lngFound& <> 0
    lngEnd& = InStr(lngFound&, strIn$, ">")
    If lngEnd& <> 0 Then
      strLeft$ = Left(strIn$, lngFound& - 1)
      strRight$ = Right(strIn$, lngLen& - lngEnd&)
      strIn$ = strLeft$ & strRight$
      lngLen& = Len(strIn$)
    End If
    lngFound& = InStr(lngFound& + 1, strIn$, "<FONT ")
  Loop
  strIn$ = Replace(strIn$, "&", "&")
  strIn$ = Replace(strIn$, "&lt;", "<")
  KillHTML$ = strIn$
End Function

What about something like this?

VB Code:

Function RemoveHTML(strHTML As String) As String
Do
    tagOpen = InStr(1, strHTML, "<")
    tagClose = InStr(1, strHTML, ">")
    strHTML = Replace(strHTML, Mid(strHTML, tagOpen, tagClose - tagOpen + 1), "")
    Debug.Print strHTML
Loop Until InStr(1, strHTML, "<") = 0
RemoveHTML = strHTML
End Function

Mar 9th, 2003, 10:53 AM
BrandonTurner

your way is about 10x faster and effective. congrats
Mar 9th, 2003, 07:41 PM
da_silvy

No worries,

you could also replace html characters etc, if needed.
Mar 12th, 2003, 06:33 PM
jdc6029

Hey da_silvy.
That does look like a fast way but how would you use it? For instance, if you had the Html in Text1. I've tried a lot of different way but just get an invalid procedure error.
Mar 13th, 2003, 06:54 AM
da_silvy
VB Code:
```
Text1.Text = RemoveHTML(Text1.Text)
```
HTH
Mar 14th, 2003, 06:06 AM
jdc6029

Text1.Text = RemoveHTML(Text1.Text)

That's the call I'm using but I get an "Invalid Procedure" on this line

strHTML = Replace(strHTML, Mid(strHTML, tagOpen, tagClose - tagOpen + 1), "")
Mar 18th, 2003, 02:22 AM
da_silvy

What text are you trying to kill tags in?
Mar 18th, 2003, 03:34 AM
Frans C

It looks like a missing closing tag (or opening tag).
Mar 18th, 2003, 06:53 AM
jdc6029

What text are you trying to kill tags in?

I've loaded the Html code from a web page into Text1