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

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Post Reply
User avatar
truongphu
VIP
VIP
Posts: 4781
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 525 times

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

Post by 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, "&", "&")
  19.     strContent = Replace(strContent, """, "'")
  20.    strContent = Replace(strContent, "&#", "#")
  21.     strContent = Replace(strContent, "<", "<")
  22.     strContent = Replace(strContent, ">", ">")
  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


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
Attachments
Tách các the Tag StripTags.rar
(3.31 KiB) Downloaded 444 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
Post Reply

Return to “[VB] Chuỗi và Thời gian”