Trang 1 trên 1

Xóa các tag của source trang web

Đã gửi: T.Hai 23/04/2012 7:14 am
gửi bởi truongphu
Thủ thuật: Xóa các tag của source trang web
Tác giả: By Herman Liu VB6, by truongphu VBA
Mô tả: By Herman Liu



VB6:
  1. Private Sub cmdStripTags_click()
  2.     On Error Resume Next
  3.     Dim strContent As String, mString As String
  4.     Dim mStartPos As Long, mEndPos As Long
  5.     Dim i, j
  6.     strContent = Text1.Text
  7.        ' Start process
  8.    mStartPos = InStr(strContent, "<")
  9.     mEndPos = InStr(strContent, ">")
  10.     Do While mStartPos <> 0 And mEndPos <> 0 And mEndPos > mStartPos
  11.           mString = Mid(strContent, mStartPos, mEndPos - mStartPos + 1)
  12.           strContent = Replace(strContent, mString, "")
  13.           mStartPos = InStr(strContent, "<")
  14.           mEndPos = InStr(strContent, ">")
  15.     Loop
  16.        ' Translate common escape sequence chars
  17.    strContent = Replace(strContent, "&nbsp;", " ")
  18.     strContent = Replace(strContent, "&amp;", "&")
  19.     strContent = Replace(strContent, "&quot;", "'")
  20.     strContent = Replace(strContent, "&#", "#")
  21.     strContent = Replace(strContent, "&lt;", "<")
  22.     strContent = Replace(strContent, "&gt;", ">")
  23.     strContent = Replace(strContent, "%20", " ")
  24.     strContent = LTrim(Trim(strContent))
  25.     Do While Left(strContent, 1) = Chr$(13) Or Left(strContent, 1) = Chr$(10)
  26.           strContent = Mid(strContent, 2)
  27.     Loop
  28.     Text1.Text = strContent
  29.        ' If any angle brackets still exist, highlight the first one
  30.    i = InStr(Text1.Text, "<")
  31.     j = InStr(Text1.Text, ">")
  32.     If j < i And j > 0 Then i = j
  33.     If i > 0 Then
  34.           Text1.SelStart = i - 1
  35.           Text1.SelLength = 1
  36.     ElseIf j > 0 Then
  37.           Text1.SelStart = j - 1
  38.           Text1.SelLength = 1
  39.     End If
  40.     Text1.SetFocus
  41. End Sub
  42.  


VBA:
  1. Private Sub Command1_Click()
  2. On Error Resume Next
  3. Dim objWord As Object ' code by truongphu
  4. Set objWord = CreateObject("Word.Application")
  5. objWord.Documents.Add
  6. objWord.Selection.Text = Text1.Text
  7. objWord.Selection.Find.ClearFormatting
  8.     With objWord.Selection.Find
  9.         .MatchWildcards = True
  10.         .Text = "\<*\>"
  11.         .Replacement.Text = ""
  12.         .Wrap = 1 'wdFindContinue
  13.    End With
  14. objWord.Selection.Find.Execute Replace:=2 'wdReplaceAll
  15. objWord.Selection.WholeStory
  16. Text1.Text = objWord.Selection
  17. objWord.quit False: Set objWord = Nothing
  18. End Sub