XL 2016 Recherche d'url valides

[azraelle]

Bonjour à tous, c'est mon premier post dans ce forum. Je ne suis pas débutante sur Excel, mais je ne suis pas experte non plus. J'utilise des macros régulièrement pour automatiser des tâches dans mon boulot, mais là je sèche.
J'ai un fichier avec une seule colonne qui comprend des URL.
Mon souci : avoir dans la deuxième colonne OK si l'URL est valide, et NOK si elle ne l'est pas.
Comme mon fichier fait environ 160 000 lignes, je ne suis pas très partant pour vérifier les URL à la main...
Je travaille sur Excel 2016.
Merci d'avance pour l'aide que vous pourrez m'apporter, bonne soirée 🙂

 

[azraelle]

J'ai une dernière question, comment puis-je adapter cette macro à un fichier plus long (disons qu'il y ait 100 URL) ?

 

[jurassic pork]

J'ai une dernière question, comment puis-je adapter cette macro à un fichier plus long (disons qu'il y ait 100 URL) ?

Dans le gestionnaire de Noms (Formules/Gestionnaire de Noms) il faut que tu changes la dernière ligne à utiliser dans la plage nommée Urls :

cliquer sur le bouton v (vert) pour valider

 

[azraelle]

Dans le gestionnaire de Noms (Formules/Gestionnaire de Noms) il faut que tu changes la dernière ligne à utiliser dans la plage nommée Urls :
Regarde la pièce jointe 1212269
cliquer sur le bouton v (vert) pour valider

Yes, ça fonctionne ! J'ai essayé avec toute la colonne A, ça bug. Dommage, ça m'aurait évité de changer la plage à chaque fichier.
Encore merci pour toutes tes recherches, et ta patience 🙂 Dès demain je m'y colle sur mon gros fichier !

 

[azraelle]

C'est encore moi.
J'ai testé cette macro dans mon fichier original, ça fonctionne super bien sauf pour les erreurs du type

http://static1.lecteurs.com/files/books-covers/467/9782868241467_1_75.jpg?v901

Pour laquelle j'ai ce message d'erreur : (Alors que le lien mène bien vers une image)

http://static2.easykado.com/media/catalog/product/cache/1/image/1378x1173/9df78eab33525d08d6e5fb8d27136e95/a/1/a151257.jpg

Pour lequel j'ai le message d'erreur :

et

Y a-t-il moyen de faire quelque chose ?

 

[jurassic pork]

Hello,
la première erreur c'est parce que tu as ?v901 à la fin de ton url. La deuxième je ne sais pas .
J'ai changé le code . L'objet qui est utilisé pour les requêtes est plus élaboré . Si le nom d'image se termine par ?xxxx je supprime cette partie. Quand il y a une erreur je ne bloque pas je passe à l'image suivante (il n'y ni OK ni NOK sur la ligne)

Sub DownloadImages()
Dim myURL As String
Dim cell, dlPath$, NomImg$, imgSrc$, splitter
Dim WinHttpReq As Object, oStream As Object, RegEx As Object, Matches As Object
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Set oStream = CreateObject("ADODB.Stream")
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "[^/\\]+$" ' Motif pour extraire nom d'image dans URL
dlPath = "D:\tmp\dlImages\"
For Each cell In Sheets("Feuil1").Range("Urls")
    imgSrc = cell
    Set Matches = RegEx.Execute(imgSrc)
    If Matches.Count = 1 Then
       splitter = Split(Matches(0), "?")
       NomImg = splitter(0)
       Debug.Print NomImg
    Else
       Cells.Offset(0, 3) = "Nom d'image incorrect"
       GoTo NextIteration
    End If
    On Error GoTo NextIteration
    WinHttpReq.Open "GET", imgSrc, False
    WinHttpReq.send
   ' Debug.Print imgSrc, WinHttpReq.Status
    If WinHttpReq.Status = 200 Then
       oStream.Open
       oStream.Type = 1
       oStream.Write WinHttpReq.responseBody
    
       oStream.SaveToFile dlPath & NomImg, 2 ' 1 = no overwrite, 2 = overwrite
       oStream.Close
       cell.Offset(0, 1) = "OK"
       cell.Offset(0, 3) = NomImg
    Else
       cell.Offset(0, 1) = "NOK"
       cell.Offset(0, 2) = WinHttpReq.Status
    End If
NextIteration:
Next cell
Set WinHttpReq = Nothing: Set oStream = Nothing: Set Matches = Nothing: Set RegEx = Nothing
MsgBox "Vérification terminée !"
End Sub

Ne pas oublier de changer le dlPath dans le code 😉

Ami calmant, J.P

 

[azraelle]

Hello,
la première erreur c'est parce que tu as ?v901 à la fin de ton url. La deuxième je ne sais pas .
J'ai changé le code . L'objet qui est utilisé pour les requêtes est plus élaboré . Si le nom d'image se termine par ?xxxx je supprime cette partie. Quand il y a une erreur je ne bloque pas je passe à l'image suivante (il n'y ni OK ni NOK sur la ligne)

Sub DownloadImages()
Dim myURL As String
Dim cell, dlPath$, NomImg$, imgSrc$, splitter
Dim WinHttpReq As Object, oStream As Object, RegEx As Object, Matches As Object
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Set oStream = CreateObject("ADODB.Stream")
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "[^/\\]+$" ' Motif pour extraire nom d'image dans URL
dlPath = "D:\tmp\dlImages\"
For Each cell In Sheets("Feuil1").Range("Urls")
    imgSrc = cell
    Set Matches = RegEx.Execute(imgSrc)
    If Matches.Count = 1 Then
       splitter = Split(Matches(0), "?")
       NomImg = splitter(0)
       Debug.Print NomImg
    Else
       Cells.Offset(0, 3) = "Nom d'image incorrect"
       GoTo NextIteration
    End If
    On Error GoTo NextIteration
    WinHttpReq.Open "GET", imgSrc, False
    WinHttpReq.send
   ' Debug.Print imgSrc, WinHttpReq.Status
    If WinHttpReq.Status = 200 Then
       oStream.Open
       oStream.Type = 1
       oStream.Write WinHttpReq.responseBody
   
       oStream.SaveToFile dlPath & NomImg, 2 ' 1 = no overwrite, 2 = overwrite
       oStream.Close
       cell.Offset(0, 1) = "OK"
       cell.Offset(0, 3) = NomImg
    Else
       cell.Offset(0, 1) = "NOK"
       cell.Offset(0, 2) = WinHttpReq.Status
    End If
NextIteration:
Next cell
Set WinHttpReq = Nothing: Set oStream = Nothing: Set Matches = Nothing: Set RegEx = Nothing
MsgBox "Vérification terminée !"
End Sub

Ne pas oublier de changer le dlPath dans le code 😉

Ami calmant, J.P

Yes, merci, je vois ça demain, et promis, j'oublie pas de changer le dlpath 😉
Encore une énorme merci, bonne soirée,
Brigitte

 

[azraelle]

Malgré quelques erreurs qui restent (ex : http://www.cvs-mediatheques.com/ws/wsgetimg.php?N=a0EQ2652&C=2898&D=1003456&A=37645&W=100&F=0) ça fonctionne super bien ! Un grand merci 🙂

 

[jurassic pork]

Malgré quelques erreurs qui restent (ex : http://www.cvs-mediatheques.com/ws/wsgetimg.php?N=a0EQ2652&C=2898&D=1003456&A=37645&W=100&F=0) ça fonctionne super bien ! Un grand merci 🙂

Hello,
oui la c'est normal qu'il y ait une erreur il n'y a pas de nom d'image dans l'url
Ami calmant, J.P