A macro to check if a URL exists

  • Thread starter Thread starter ×ליר×
  • Start date Start date
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!
 
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
'***************************************************************
 
Back
Top