Test URLs

lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011 - 26 janv. 2011 à 11:40
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011 - 20 juin 2011 à 07:08
Bonjour,

j'ai une feuille excel avec 244 urls placé dans des cellule. J'aimerai avoir une macro qui pourrait tester ces liens et me lister tout les liens qui sont mort.
Quelqu'un aurait une idée?
Merci d'avance

Laurent

10 réponses

Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
26 janv. 2011 à 12:44
Bonjour,

Il te faut mettre une référence à "Microsoft WinHTTP Services" et utiliser la classe WinHttpRequest.

Pour chaque envoi de ton URL, récupère l'erreur éventuelle par On Error GoTo xxx.


Calade
0
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011
26 janv. 2011 à 13:05
Merci d'avoir répondu aussi vite.
Vous n'auriez pas un code complet en exemple?

Laurent
0
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
26 janv. 2011 à 13:11
Voici un copier-coller d'un vieux code que j'avais utilisé. A toi de l'adapter:

   Dim HTTPReq As WinHttpRequest
On Error GoTo Error

   Set HTTPReq = New WinHttpRequest

   HTTPReq.SetTimeouts 60000, 120000, 120000, 180000
   HTTPReq.Open "GET", tonURL, False
   HTTPReq.Send

...
   Exit SUb

Error:
' Code en cas d'erreur   


Calade
0
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011
26 janv. 2011 à 13:24
Il me met "erreur de compilation" Type non défini par l'utilisateur non défini???
HTTPReq As WinHttpRequest
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
26 janv. 2011 à 13:28
As-tu mis la référence que je t'ai dite ?


Calade
0
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011
26 janv. 2011 à 13:30
Je comprend rien... Ou puis-je mettre une référence "Microsoft WinHTTP Services" et pourquoi?
0
Calade Messages postés 1207 Date d'inscription dimanche 20 avril 2003 Statut Membre Dernière intervention 4 juin 2016 10
26 janv. 2011 à 13:36
Sous l'Editeur de Code, menu "Outils/Références" et tu coches "Microsoft WinHTTP Services".


Calade
0
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011
26 janv. 2011 à 13:42
ok merci
0
ahmedamri Messages postés 1 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 17 juin 2011
17 juin 2011 à 15:57
et pour vb.net????? meme après l'ajout de "Microsoft WinHTTP Services" il ma'affiche toujours type is not defined.
merci
0
lermoyeuxl Messages postés 7 Date d'inscription mercredi 26 janvier 2011 Statut Membre Dernière intervention 20 juin 2011
20 juin 2011 à 07:08
Voici une petite macro sur un test de liens si ça peut aider quelqu'un...



Sub Test()

'Dim RetVal As Long
Dim nl, ct As Integer
Dim webIE As SHDocVw.InternetExplorer
Dim strPage As String
Dim lng As Long
ct = 0
nl = 2
Do While Cells(nl, 1).Value <> ""

If Cells(nl, 2).Value <> "" Then

Set webIE = New SHDocVw.InternetExplorer
'Application.Wait Now + TimeValue("00:00:10") temporisation modèle 1
webIE.Navigate Cells(nl, 2).Text
'debut = Timer temporisation modèle 2
'fin = 15
'Do While Timer < debut + fin
'DoEvents
'Loop
Do Until webIE.ReadyState = READYSTATE_COMPLETE


DoEvents
Loop
strPage = webIE.Document.body.innerHTML
'MsgBox strPage

lng = InStr(1, strPage, "Illegal")

'MsgBox lng
If lng <> 0 Then
Cells(nl, 2).Interior.ColorIndex = 3
ct = ct + 1

End If
End If

nl = nl + 1
Loop
MsgBox "test terminé " & vbCrLf & ct & " liens non valides" & vbCrLf & nl & " liens testés"
End Sub




Public Function GetHTMLContent(ByRef vsURL As String) As String
Dim hOpen As Long
Dim hFile As Long
Dim sBuffer As String * &H2000&
Dim nLength As Long
hOpen = InternetOpen("C:\Program Files\Internet Explorer\iexplore.exe" & Cells(nl, 2).Text, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hOpen Then
hFile = InternetOpenUrl(hOpen, vsURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hFile Then
Do
InternetReadFile hFile, ByVal sBuffer, &H2000&, nLength
GetHTMLContent = GetHTMLContent & Left$(sBuffer, nLength)
Loop While nLength
InternetCloseHandle hFile
End If
InternetCloseHandle hOpen
End If
End Function
0
Rejoignez-nous