PDA

View Full Version : Search Webpage for word



mrpetreli
05-21-2017, 02:28 PM
I have a list of websites in a column B. How do I search each webpage for a specific word.

I read the help topic t-36107 here but more help would be appreciated.

mdmackillop
05-21-2017, 03:12 PM
One way here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=295). What is the desired result?

mrpetreli
05-22-2017, 08:44 AM
Desired result ... if the website url is in column B return True or False in the adjacent cell Column C

mdmackillop
05-22-2017, 12:08 PM
Based upon this (https://stackoverflow.com/questions/18432917/search-a-web-page-for-a-particular-text)

Option Explicit
Option Compare Text


Sub WebSearch()
Dim site As String, msg As String
Dim lastRow As Long
Dim ie
Dim TextToFind As String
Dim i As Long

TextToFind = "website"


With ActiveSheet
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
'idle while ie is busy
For i = 1 To lastRow
site = Range("C" & i).Value
ie.Navigate site
Do
Loop Until ie.ReadyState = 3
Do
Loop Until ie.ReadyState = 4
msg = ie.Document.Body.innerhtml
Range("B" & i).Value = InStr(msg, TextToFind) > 0
Next i
error:
ie.Quit
End Sub

Leith Ross
05-22-2017, 04:08 PM
Hello mrpetreli,

Here is another method you can use. This method is faster and far less error prone than using the IE Browser object for this job.

You actually can have 3 outcomes for a URL: True if the word is found, False if the word is not found, and error if there is a problem reaching or accessing the site. This code provides you will all three.

Initially all the cells in column "C" are set to False. As each URL is opened it is checked for a possible error. If there is an error then the error and it's message are displayed in red font.

If there is no error then the word is searched for in the page source text. If it is found then the cell in column "C" will be changed to True.

Macro Code


Sub FindWordInPage()


Dim Keyword As String
Dim Rng As Range
Dim RngBeg As Range
Dim Text As String
Dim URL As Variant
Dim Wks As Worksheet

Set Wks = Worksheets("Sheet1")

Set RngBeg = Wks.Range("B2")

Keyword = Range("A2")

Set Rng = Wks.Range(RngBeg, Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp))
If Rng.Row < RngBeg.Row Then Exit Sub

Rng.Offset(0, 1).Value = False
Rng.Offset(0, 1).Font.ColorIndex = xlColorIndexAutomatic

With CreateObject("MSXML2.XMLHTTP")
For Each URL In Rng.Cells
.Open "GET", URL, False
.Send
If .Status = 200 Then
Text = .responseText
If InStr(1, Text, Keyword) > 0 Then URL.Offset(0, 1) = True
Else
URL.Offset(0, 1).Font.Color = vbRed
URL.Offset(0, 1).Value = "ERROR: - " & .Status & " " & .statusText
End If
Next URL
End With

End Sub

mdmackillop
05-22-2017, 05:25 PM
Thanks Leith,
A much better solution

Leith Ross
05-22-2017, 05:46 PM
Hello mdmackillop,

'S e do bheatha!

Glad you like it. This can not be used to replace all of IE functionality but it handy for a lot processing needs.

mrpetreli
05-26-2017, 01:20 AM
Thanks guys, I will test this out soon

snb
05-26-2017, 02:29 AM
Use arrays if possible.


Sub M_snb()
sn = sheets("Sheet1").cells(1).currentregion.resize(,3)

With CreateObject("MSXML2.XMLHTTP")
For j=2 to ubound(sn)
.Open "GET", sn(j,2), False
.Send
sn(j,3)= instr(.responsetext,sn(1,1))>0
Next
End With

sheets("Sheet1").cells(1).currentregion.resize(,3)=sn
End Sub

mrpetreli
05-27-2017, 07:18 AM
Hi Guys

I am getting Error (Access Denied) on .send ..could it be to do with MSXML2.XMLHTTP ? How do enable that in references library as I don't see it there


With CreateObject("MSXML2.XMLHTTP")
For Each URL In Rng.Cells
.Open "GET", URL, False
.Send

mdmackillop
05-27-2017, 08:23 AM
I can run that code with these references

mrpetreli
05-27-2017, 09:20 AM
I can run that code with these references

I changed the internet options > security tab > custom security level > Miscellaneous >Access data sources across domains > enable

This is the error I am getting now
Run-time error '-2147467259(80004005)'