Validité d'une liste d'URL

J'ai dans Excel une liste d'URL dans une colonne du type http://www.yahoo.fr Je voudrais les tester pour contrôler si elles sont valides.

Une petite macro qui se contente de mettre en colonne B "OK" ou "Erreur" selon que les URL en colonne A correspondent à des pages actuellement accessible ou non. Et "Redirection vers..." si la page est automatiquement redirigée vers une autre URL.

 Private Declare Function InternetOpenA Lib "Wininet" _
 (ByVal lpszAgent As String, ByVal dwAccessType As Long, _
 ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, _
 ByVal dwFlags As Long) As Long
 
 Private Declare Function InternetCloseHandle Lib "Wininet" _
 (ByVal hInternet As Long) As Long
 
 Private Declare Function InternetOpenUrlA Lib "Wininet" _
 (ByVal hInternet As Long, ByVal lpszUrl As String, _
 ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
 ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
 Private Declare Function InternetQueryOptionA Lib "Wininet" _
 (ByVal hInternet As Long, ByVal dwOption As Long, _
 ByVal lpBuffer As String, lpdwBufferLength As Long) As Long
 
 sub Test()
 Dim hInt As Long, hInt2 As Long, Cell As Range
 Dim Buffer As String, dwBufferLength As Long
 hInt = InternetOpenA("Excel", 0, vbNullString, vbNullString, &H200000)
 With Range("A1", [A1].End(xlDown))
  .Offset(0, 1).Clear
  For Each Cell In .Cells
   Cell(, 2).Select
   hInt2 = InternetOpenUrlA(hInt, Cell, vbNullString, 0, 0, 0)
   If hInt2 Then
    dwBufferLength = 0
    InternetQueryOptionA hInt2, 34, vbNullString, dwBufferLength
    Buffer = Space$(dwBufferLength - 1)
    InternetQueryOptionA hInt2, 34, Buffer, dwBufferLength
    If Buffer = Cell Or Buffer = Cell & "/" Then _
     ActiveCell = "OK" Else ActiveCell = "Redirigé vers " & Buffer
    InternetCloseHandle hInt2
   Else: ActiveCell = "Erreur"
   End If
  Next Cell
  .Columns(2).AutoFit
 End With
 InternetCloseHandle hInt
 end sub

Attention, une URL marquée "Erreur" ne correspond pas forcément à une page inexistante. L'erreur peut être due à un serveur temporairement défaillant. De même, une URL "OK" ne correspond pas forcément à une page réellement existante, mais peut résulter d'une page d'erreur "404 Not Found". Donc rien ne vaut les vérifications "manuelles"!

Auteur :

Mots clefs associés à cette page : , ,