A macro to check if a URL exists

[×ליר×]

Hi,

I have a spreadsheet which contains about 3,000 URL addresses.

I'd like to create a macro that scan each address and print in the next
column if the URL exists.

For instance:

Column A Column B
www.google.com | valid
www.gfgfgfgfgfgf.org | invalid
www.msn.com | valid


Thanks.

 

[Tim Williams]

Untested

'*********************************
Sub Tester()
dim c as range, tmp

for each c in activesheet.range("A2:A3002")
tmp=trim(c.value)
if len(tmp)>0 then
if not ucase(tmp) like "HTTP*" then tmp = "http://" & tmp
c.offset(0,1).value=iif(HttpExists(tmp),"OK","Not OK")
end if
next c
End Sub

Function HttpExists(sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = (oXHTTP.Status = 200)
End Function
'*************************

Tim

 

[×ליר×]

Hi Tim,

Thank you for your reply.

I copy+pasted the sub and the function to a new VBA module.

I wrote in B2 "=httpexists(A2)" and I got #VALUE!

What could be the problem?


Thank you!

 

[Tim Williams]

I would not recommend using that function as a worksheet formula: it
may end up executing many more times than you need.
You can drive the checking from a sub instead (as shown) - link it to
a button on the sheet if you need to be able to run an updated check.

That said, here's a more self-contained version which works for me as
a UDF on a small list of test URLs.

Tim

'***************************************************************
Function HttpExists(sURL As String) As String
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")

If Not UCase(sURL) Like "HTTP:*" Then
sURL = "http://" & sURL
End If

On Error GoTo haveError
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = IIf(oXHTTP.Status = 200, "OK", "Not OK")
Exit Function
haveError:
HttpExists = "Not OK"
End Function
'***************************************************************