Sub test1()
Dim cellule As Range
Do Until Range("A2") = ""
Call lien1
Loop
End Sub
Sub lien1()
DownloadHTTP Range("A2").Hyperlinks(1).Address, "C:\Myrep\MyFicher.Extension"
Rows(2).Delete Shift:=xlUp
End Sub
Public Function DownloadHTTP(ByVal URL As String, ByVal Destination As String) As Boolean
On Error GoTo catch
Dim oWinHTTP As Object
Dim fic As Integer
Dim buffer() As Byte
Set oWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
oWinHTTP.Open "GET", URL, False
oWinHTTP.send
If oWinHTTP.Status = 200 Then
fic = FreeFile
Open Destination For Binary Lock Read Write As #fic
buffer = oWinHTTP.ResponseBody
Put #fic, , buffer
Close #fic
DownloadHTTP = True
Else
MsgBox "Statut retourné par le service : " & oWinHTTP.Status & vbCrLf & _
"Description : " & oWinHTTP.StatusText, vbExclamation, "DownloadHTTP()..."
End If
finally:
Erase buffer
Set oWinHTTP = Nothing
Exit Function
catch:
MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description, vbExclamation, "DownloadHTTP()..."
Close 'ferme to descripteurs ouverts
Resume finally
End Function