复制代码 代码如下:
'==============================
'功能描述： 用正则除去HTML标记
'不能保留<b><strong>等以及用户自定义的<和>
'==============================

Function RemoveHTMLTag(fString)
        Dim re
        Set re = New RegExp
        re.IgnoreCase = True
        re.Pattern = "<(.[^>]*)>"
        fString = re.Replace(fString, "")
        Set re = Nothing
        RemoveHTMLTag = fString
End Function

'==============================
'功能描述： 除去HTML标记
'不能保留<b><strong>等以及用户自定义的<和>
'==============================

Function Remove_HTML(Str)
        Dim ilen1, ilen2
        Do While InStr(1, Str, "<", 1) >0
                ilen1 = InStr(1, Str, "<", 1)
                ilen2 = InStr(1, Str, ">", 1)
                Str = Left(Str, ilen1 -1) & Mid(Str, ilen2 + 1)
        Loop
        Remove_HTML = Str
End Function

'==============================
'功能描述： 除去HTML标记
'去除自定义的标记,速度可能有点慢
'==============================

Function RemoveHTML(strText)
        Dim TAGLIST
        TAGLIST = ";!--;!DOCTYPE;A;ACRONYM;ADDRESS;APPLET;AREA;B;BASE;BASEFONT;" &_
        "BGSOUND;BIG;BLOCKQUOTE;BODY;BR;BUTTON;CAPTION;CENTER;CITE;CODE;" &_
        "COL;COLGROUP;COMMENT;DD;DEL;DFN;DIR;DIV;DL;DT;EM;EMBED;FIELDSET;" &_
        "FONT;FORM;FRAME;FRAMESET;HEAD;H1;H2;H3;H4;H5;H6;HR;HTML;I;IFRAME;IMG;" &_
        "INPUT;INS;ISINDEX;KBD;LABEL;LAYER;LAGEND;LI;LINK;LISTING;MAP;MARQUEE;" &_
        "MENU;META;NOBR;NOFRAMES;NOSCRIPT;OBJECT;OL;OPTION;P;PARAM;PLAINTEXT;" &_
        "PRE;Q;S;SAMP;SCRIPT;Select;SMALL;SPAN;STRIKE;STRONG;STYLE;SUB;SUP;" &_
        "TABLE;TBODY;TD;TEXTAREA;TFOOT;TH;THEAD;TITLE;TR;TT;U;UL;VAR;WBR;XMP;"

        Const BLOCKTAGLIST = ";APPLET;EMBED;FRAMESET;HEAD;NOFRAMES;NOSCRIPT;OBJECT;SCRIPT;STYLE;"

        Dim nPos1
        Dim nPos2
        Dim nPos3
        Dim strResult
        Dim strTagName
        Dim bRemove
        Dim bSearchForBlock

        nPos1 = InStr(strText, "<")
        Do While nPos1 > 0
                nPos2 = InStr(nPos1 + 1, strText, ">")
                If nPos2 > 0 Then
                        strTagName = Mid(strText, nPos1 + 1, nPos2 - nPos1 - 1)
                        strTagName = Replace(Replace(strTagName, vbCr, " "), vbLf, " ")

                        nPos3 = InStr(strTagName, " ")
                        If nPos3 > 0 Then
                                strTagName = Left(strTagName, nPos3 - 1)
                        End If


                        If Left(strTagName, 1) = "/" Then
                                strTagName = Mid(strTagName, 2)
                                bSearchForBlock = False
                        Else
                                bSearchForBlock = True
                        End If

                        If InStr(1, TAGLIST, ";" & strTagName & ";", vbTextCompare) > 0 Then
                                bRemove = True
                                If bSearchForBlock Then
                                        If InStr(1, BLOCKTAGLIST, ";" & strTagName & ";", vbTextCompare) > 0 Then
                                                nPos2 = Len(strText)
                                                nPos3 = InStr(nPos1 + 1, strText, "</" & strTagName, vbTextCompare)
                                                If nPos3 > 0 Then
                                                        nPos3 = InStr(nPos3 + 1, strText, ">")
                                                End If

                                                If nPos3 > 0 Then
                                                        nPos2 = nPos3
                                                End If
                                        End If
                                End If
                        Else
                                bRemove = False
                        End If

                        If bRemove Then
                                strResult = strResult & Left(strText, nPos1 - 1)
                                strText = Mid(strText, nPos2 + 1)
                        Else
                                strResult = strResult & Left(strText, nPos1)
                                strText = Mid(strText, nPos1 + 1)
                        End If
                Else
                        strResult = strResult & strText
                        strText = ""
                End If

                nPos1 = InStr(strText, "<")
        Loop
        strResult = strResult & strText
        strResult = Replace(strResult, Chr(9), "")
        strResult = Replace(strResult, Chr(32), "")
        strResult = Replace(strResult, Chr(13), "")
        strResult = Replace(strResult, Chr(10), "")
        strResult = Replace(strResult, vbCrLf, "")
        RemoveHTML = strResult
End Function