Question : Checking existence of hyperlink from VBA

Is there a way to check if a url exist in Excel VBA.

I'm maintaining a website which includes a number of hyperlinks. The hyperlinks are saved in an Excel workbook where a VBA macro creates the HTML-code. At this time I (ought to) control the existence of the url-adresses manually. I would like to do this automatically producing a worksheet with the links and their validity.

The structure is:
A1:C1 Headers
Column A : Text to be shown in the HTML-document
Column B : Hyperlink
Column C : Comment to the hyperlink to be shown in the HTML-document

I'm not desperate (yet ?) but it would be nice to have an automated procedure to do the control.

Claus Henriksen

Answer : Checking existence of hyperlink from VBA

Hi Claus,

Maybe this will help?

Public Sub Q_20882190()

  MsgBox (blnDoes_URL_Exist("http://www.microsoft.com"))
  MsgBox (blnDoes_URL_Exist("http://NigelLee.Info"))
  MsgBox (blnDoes_URL_Exist("http://Does_Not_Exist.com"))
 
End Sub
Public Function blnDoes_URL_Exist(ByVal strURL As String) As Boolean

  Dim blnReturn                                         As Boolean
  Dim lngConnect_Timeout                                As Long
  Dim lngReceive_Timeout                                As Long
  Dim lngResolve_Timeout                                As Long
  Dim lngSend_Timeout                                   As Long
  Dim objMSXML2_ServerXMLTPP                            As Object
 
  On Error GoTo Err_blnDoes_URL_Exist
 
  blnReturn = False
  lngConnect_Timeout = 500&
  lngReceive_Timeout = 500&
  lngResolve_Timeout = 500&
  lngSend_Timeout = 500&

  Set objMSXML2_ServerXMLTPP = CreateObject("MSXML2.ServerXMLHTTP")
 
  objMSXML2_ServerXMLTPP.SetTimeouts lngResolve_Timeout, lngConnect_Timeout, lngSend_Timeout, lngReceive_Timeout
  objMSXML2_ServerXMLTPP.Open "GET", strURL
  objMSXML2_ServerXMLTPP.Send
 
  blnReturn = (objMSXML2_ServerXMLTPP.Status = 200)
 
Exit_blnDoes_URL_Exist:

  On Error Resume Next
 
  Set objMSXML2_ServerXMLTPP = Nothing
 
  blnDoes_URL_Exist = blnReturn
 
  Exit Function
 
Err_blnDoes_URL_Exist:

  blnReturn = False
 
  Resume Exit_blnDoes_URL_Exist
 
End Function


BFN,

fp.