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(s) : 

Ce mois-ci sur Excelabo

- Pas de nouvelle page.
- Pas de page modifiée