Aide à la création d'une macro pour télécharger des images

Bonjour tout le monde,

J'écris ce message car j'aurai besoin d'un petit coup de main concernant la création d'une macro pour télécharger des images depuis des liens situés dans une colonne de Exel. (Voir document joint)

J'ai utiliser un logiciel de scrapping pour récupérer la data d'un catalogue d'image d'un site. Mais problème, dans mon exel là où il devrait y avoir des images, il y a seulement leurs liens (Colonne B). J'ai fait mes recherches et j'ai trouver cette article : http://stackoverflow.com/questions/14675830/how-to-download-all-links-in-column-a-in-a-folder?noredirect=1&lq=1

Petit problème, je n'ai jamais réussit à configurer le bout de code en question pour faire marcher cette macro.

Auriez vous une solution plus simple pour le même résultat? Savez vous configurer ce genre de code?

Je vous remercie d'avance pour votre aide

Bonjour,

Les données de ton csv sont à nettoyer pour obtenir des liens fonctionnels.

Sinon, une fois avec des des données propres, on peut faire comme ceci :

Option Explicit

Sub Import_Jpg()
Dim T As Variant
Dim Rep As String, Url As String, NDF As String
Dim lig As Long, i As Long, idx As Integer

    With ActiveSheet
        lig = .Cells(Rows.Count, 1).End(xlUp).Row
        T = .Range(.Cells(1, "A"), .Cells(lig, "B")).Value
    End With

    Rep = ThisWorkbook.Path & "\Jpg\"
    If Not Exist_Rep(Rep) Then MkDir Rep

    For i = 2 To lig
        Url = T(i, 2)
        NDF = Rep & Right(Url, InStr(1, StrReverse(Url), "/") - 1)
        If Not Exist_Fichier(NDF) Then idx = DownloadHTTP(Url, NDF)
    Next i

End Sub

Function Exist_Rep(Rep As String) As Boolean
    On Error Resume Next
    Exist_Rep = GetAttr(Rep) And vbDirectory
End Function

Public Function Exist_Fichier(S As String) As Boolean
Dim tatiak As Object

    Set tatiak = CreateObject("Scripting.FileSystemObject")
    Exist_Fichier = tatiak.FileExists(S)
End Function

Function DownloadHTTP(Url As String, NDF As String) As Integer
Dim f As Integer, buffer() As Byte

    On Error GoTo errhdlr
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .send
        If .Status = 200 Then
           f = FreeFile
           Open NDF For Binary As #f
           buffer = .responseBody
           Put #f, , buffer
           Erase buffer
           Close #f
           DownloadHTTP = 0
        End If
    End With
    Exit Function

errhdlr:
    DownloadHTTP = -1
End Function