Tester des liens HTTP

Version imprimable

Bonjour,

Dans un fichier Excel se trouve plusieurs adresse web dans la colonne A, et j'aimerais afficher dans la colonne B si l'adresse est accessible (OUI ou NON)

J'ai trouvé ces codes, mais je ne sais pas comment les adapter à mes besoins :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub Test_page_Web_1() 
'On peut tenter d'ouvrir la page directement sous Excel, et intercepter l'erreur qui se produit si la page n'est pas valide (Erreur d'execution 1004)
URL_à_tester = InputBox("URL à tester ?", "validité de l'adresse Internet", "http://boursorama.fr") 
On Error GoTo Err 
Set fich = Workbooks.Open(URL_à_tester)'ouvre l'URL 
fich.Close (False) 'ferme l'URL 
MsgBox "l'URL " & URL_à_tester & " est valide" 
Exit Sub 
Err: 
MsgBox "l'URL " & URL_à_tester & " ne peut pas être ouvert" 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
'Pour gagner du temps, on peut utiliser directement les dll qui gèrent la connexion Internet, via une fonction API
Private Declare Function OuvreInternet Lib "wininet" Alias "InternetOpenA" _ 
    (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName _ 
    As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" _ 
    (ByVal hInternetSession 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 InternetCloseHandle Lib "wininet" (ByVal zaza As Long) As Integer 
 
Sub Test_page_Web_2() 
internet_ouvert = OuvreInternet("Test_validité", 1, vbNullString, vbNullString, 0) 'ouvre Internet 
URL_à_tester = InputBox("URL à tester ?", "validité de l'adresse Internet", "http://boursorama.fr") 
numURL = InternetOpenUrl(internet_ouvert, URL_à_tester, vbNullString, _ 
    ByVal 0&, &H80000000, ByVal 0&) 'ouvre la page Web 
If numURL > 0 Then MsgBox "l'URL " & URL_à_tester & " est valide" _ 
    Else MsgBox "l'URL " & URL_à_tester & " ne peut pas être ouvert" 
InternetCloseHandle numURL 'ferme la page 
InternetCloseHandle internet_ouvert 'ferme Internet 
End Sub

Merci par avance !!

Pas testé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
'Pour gagner du temps, on peut utiliser directement les dll qui gèrent la connexion Internet, via une fonction API
Private Declare Function OuvreInternet Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession 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 InternetCloseHandle Lib "wininet" (ByVal zaza As Long) As Integer
 
Sub Test_page_Web_2()
Dim Internet_Ouvert As Long, numURL As Long, LastLig As Long, i As Long
Dim URL_a_Tester As String
 
Internet_Ouvert = OuvreInternet("Test_validité", 1, vbNullString, vbNullString, 0)    'ouvre Internet
With Sheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 2 To LastLig
'Récupère l'url dans colonne A Sous Forme http://xxxxx.yy
        URL_a_Tester = .Range("A" & i).Value
        If URL_a_Tester <> "" Then
            numURL = InternetOpenUrl(Internet_Ouvert, URL_a_Tester, vbNullString, ByVal 0&, &H80000000, ByVal 0&)    'ouvre la page Web
'Ecrit le résultat du test en B
            .Range("B" & i).Value = IIf(numURL > 0, "OUI", "NON")
            InternetCloseHandle numURL                               'ferme la page
        End If
    Next i
End With
InternetCloseHandle Internet_Ouvert                                  'ferme Internet
End Sub

24/02/2011, 17h10
wyzer

trop fort !!!!!!!

merci !! :ccool:
25/02/2011, 11h00
wyzer

1 pièce(s) jointe(s)

Re,

Sur certains lien la macro me dit que le lien HTPP est valide, or il ne l'est pas

Donc je pense que le mieux serait de mettre dans la macro quelque chose comme ça :

lorsque le lien est ouvert, si la page contien le texte "Web Page Blocked", alors ça veut dire qu'elle est bloqué

C'est possible de faire ça ?

PS: j'ai mis en pièce jointe une capture de la page qui s'affiche lorsqu'un lien est bloqué