|
Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Public Sub GetFiles()
Const strBackup As String = "D:\poto\"
Dim arr
Dim TargetFile As String
Dim lngTMP, i As Long
arr = Range("a1").CurrentRegion
MakeSureDirectoryPathExists strBackup
For i = 2 To UBound(arr)
TargetFile = strBackup & arr(i, 4) & ".jpg"
Call DeleteUrlCacheEntry(arr(i, 3))
lngTMP = URLDownloadToFile(0, arr(i, 3), TargetFile, 0, 0)
If lngTMP < 0 Then
arr(i, 6) = arr(i, 3)
arr(i, 7) = arr(i, 4) & ".jpg"
Else
arr(i, 5) = TargetFile
End If
Next
Range("a1").Resize(UBound(arr), 7) = arr
End Sub |
|