Search WebPage for cell value and return 1 if exist

[MohammadKayed]

Hello,
I am new with VBA.

Can you help me to write the below code.


A B C
1 a.com Valuea 1 Or 0
2 b.com Valueb 1 Or 0
3 c.com Valuec 1 Or 0
4 d.com Valued 1 Or 0


In Column A I have the URLs and B the values that I need to search on the related URL

If the value exist in the WebPage the code will return 1 in C or 0 if not.

 

[Anthony47]

Try this macro:

Sub ckWebSite()
Dim iText As String, HTML_Doc As Object
Dim I As Long, httpObj As Object, ReqUrl As String
'
Set HTML_Doc = CreateObject("htmlfile")
Set httpObj = CreateObject("WinHttp.WinHttpRequest.5.1")
'
For I = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    Cells(I, 3).ClearContents
    HTML_Doc.Clear ' = Empty
    ReqUrl = Cells(I, 1).Value
    With httpObj
        .Open "GET", ReqUrl, False
        .send
        HTML_Doc.body.innerHTML = .responseText
    End With
    iText = HTML_Doc.getElementsByTagName("body")(0).innerText
    If InStr(1, iText, Cells(I, 2).Value, vbTextCompare) > 0 Then
        Cells(I, 3) = 1
    Else
        Cells(I, 3) = 0
    End If
Next I
End Sub

Copy the code in a standard module of your vba project; then return to Excel, select the right sheet and start Sub ckWebSite

Note that Url in column A need to be complete with the web protocol; eghttps://www.mrexcel.com, or https://mrexcel.com

Bye

 

[MohammadKayed]

Try this macro:

Sub ckWebSite()
Dim iText As String, HTML_Doc As Object
Dim I As Long, httpObj As Object, ReqUrl As String
'
Set HTML_Doc = CreateObject("htmlfile")
Set httpObj = CreateObject("WinHttp.WinHttpRequest.5.1")
'
For I = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    Cells(I, 3).ClearContents
    HTML_Doc.Clear ' = Empty
    ReqUrl = Cells(I, 1).Value
    With httpObj
        .Open "GET", ReqUrl, False
        .send
        HTML_Doc.body.innerHTML = .responseText
    End With
    iText = HTML_Doc.getElementsByTagName("body")(0).innerText
    If InStr(1, iText, Cells(I, 2).Value, vbTextCompare) > 0 Then
        Cells(I, 3) = 1
    Else
        Cells(I, 3) = 0
    End If
Next I
End Sub

Copy the code in a standard module of your vba project; then return to Excel, select the right sheet and start Sub ckWebSite

Note that Url in column A need to be complete with the web protocol; eghttps://www.mrexcel.com, or https://mrexcel.com

Bye

Thank you for the code
Unfortunately it didn't wok, I tested the below and the Cell C1 stayed empty.

 

[Anthony47]

If your Urls starts from line 1 then modify to For I = 1 To Cells(Row.etc etc

Bye

 

[MohammadKayed]

Thanks a lot !
I added another URL in the second line and started to work .

I appreciate !

 

[Anthony47]

I added another URL in the second line and started to work

Or, if the list starts from line 1, modify as per message #4

Bye

 

[MohammadKayed]

Or, if the list starts from line 1, modify as per message #4

Bye

Yes , Got the idea of the code.

One little question assume I need to change the Cells location which part of the code I need to modify.

For example the URL will be in C3 , G3 needed value and J3 for the returned value.

 

[Anthony47]

For example:

Sub ckWebSite()
Dim iText As String, HTML_Doc As Object, Param
Dim I As Long, httpObj As Object, ReqUrl As String
'
Set HTML_Doc = CreateObject("htmlfile")
Set httpObj = CreateObject("WinHttp.WinHttpRequest.5.1")
'
Param = Array("A", "B", "C")       '<<< Url column, Keywork Column, Flag Column
'
For I = 2 To Cells(Rows.Count, Param(0)).End(xlUp).Row
    Cells(I, Param(2)).ClearContents
    HTML_Doc.Clear ' = Empty
    ReqUrl = Cells(I, Param(0)).Value
    With httpObj
        .Open "GET", ReqUrl, False
        .send
        HTML_Doc.body.innerHTML = .responseText
    End With
    iText = HTML_Doc.getElementsByTagName("body")(0).innerText
    If InStr(1, iText, Cells(I, Param(1)).Value, vbTextCompare) > 0 Then
        Cells(I, Param(2)) = 1
    Else
        Cells(I, Param(2)) = 0
    End If
Next I
End Sub

Now modify Param = Array(etc etc according the comment

Bye

 

[MohammadKayed]

Thank you , I will test later this day and let you know.

I really appreciate your help.

Thanks a lot.

 

[MohammadKayed]

I have a little issue with the code.
My URLs require a login that is done on Google Chrome, can we modify it to use the google chrome browser to search the URL?

Thank you.