VBA从网页中查找文本

时间:2016-08-30 08:08:34

标签: excel vba excel-vba macros

我创建了Macro,它为我提供了所有网页上的所有网址。 我们只需要提供URL,它就会为我们提供该网页中的所有链接,并将其粘贴到一列

Private Sub CommandButton4_Click()

'We refer to an active copy of Internet Explorer
Dim ie As InternetExplorer
'code to refer to the HTML document returned
Dim html As HTMLDocument
Dim ElementCol As Object
Dim Link As Object
Dim erow As Long
Application.ScreenUpdating = False
'open Internet Explorer and go to website
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate Cells(1, 1)

'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE

Application.StatusBar = "Trying to go to website…"
DoEvents
Loop

Set html = ie.document
'Display text of HTML document returned in a cell
'Range("A1") = html.DocumentElement.innerHTML
Set ElementCol = html.getElementsByTagName("a")

For Each Link In ElementCol
erow = Worksheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Value = Link
Cells(erow, 1).Columns.AutoFit
Next

'close down IE, reset status bar & turn on screenupdating

'Set ie = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
ie.Quit
ActiveSheet.Range("$A$1:$A$2752").removeDuplicates Columns:=1, Header:=xlNo

End Sub

现在任何人都可以帮我创建宏来查找列中存在的所有这些URL中的特定文本,如果该文本存在,那么在下一列中它应该打印文本“找到文本”。

例如,如果我们搜索文本“New”,那么它应该在URL的下一列中打印文本“Text found”。

谢谢。

2 个答案:

答案 0 :(得分:1)

键是Instr函数,如果找到字符串&#34; New&#34;,则返回它开始的位置,否则返回0.

i=1
do until trim(Cells(i,1).Value) = vbNullString
    if instr(Cells(i,1).Value,"New") then
        Cells(i,2).value="Text found"
    end if
    i=i+1
loop

答案 1 :(得分:0)

与上述类似。

Dim a As Variant

a = 2

While Cells(a, 1) <> "" And Cells(a + 1, 1) <> ""

    If InStr(Cells(a, 1), "new") = 0 Then

    Else
        Cells(a, 2) = "Text Found"

    End If

    a = a + 1

Wend