Çözüldü Web den İndirilen Resimi Boyutlandırma

   Public Cell            As Range
  Public Folder          As String


  Sub DownloadAndSave()


  Folder = "C:\Users\Görsel"

  For Each Cell In Range("a2:A61")


    Call DownloadURLtoFile(Cell, Folder, Cell.Offset(0, 2))
   
  Next Cell

  MsgBox "Done...", 64
End Sub

Option Explicit

'Written:  October 26, 2016
'Author:   Leith Ross
'Summary:  Function Downloads A Web Site Resource To A Local Disk File

Private Const E_OUTOFMEMORY As Long = &H8007000E
Private Const INET_E_DOWNLOAD_FAILURE As Long = &H800C0008

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon.dll" Alias _
  "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
  ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

    Function DownloadURLtoFile(ByVal URL As String, ByVal vFolder As Variant, ByVal FileName As String) As Boolean
    Dim Msg As String
  Dim oFolder         As Object

With CreateObject("Shell.Application")
    Set oFolder = .Namespace(vFolder)
  End With

  If oFolder Is Nothing Then
    MsgBox "Folder '" & vFolder & "' Not Found.", vbExclamation
    Exit Function
  End If


    URL = "https://www.log.com.tr/wp-content/uploads/2018/04/xiaominin-destekledigi-black-shark-oyuncu-telefonundan-ilk-gorsel-1.jpg"

    Select Case URLDownloadToFile(0&, URL, vFolder & FileName, 0&, 0&)
    Case 0: GoTo Cikis
   
    Cikis:
DownloadURLtoFile = True
Cell.Offset(0, 1) = "ok"

End Select

  If Not DownloadURLtoFile Then Cell.Offset(0, 1) = "No"
End Function