Download Images from Urls

2

29sandesh

New Member
Joined
Sep 5, 2013
Messages
49
Column A contains urls, need vba module to download the images from these urls/hyperlinks to desktop. The below link has been converted to hyperlink in excel

http://i723.photobucket.com/albums/ww237/sukkhi2/Stock 23/Stock 23 Remaining/26ALPHAZ340_zpssoxAB3fbh.jpg

<tbody>
</tbody>
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
The following macro assumes that the sheet containing the hyperlinked urls is the active sheet. It also uses the function SaveWebFile. You'll need to change the path to the destination folder, accordingly. The name of the downloaded file will be the same as the name of the file specified in the url. Note, however, if a file by the same name already exists in the destination folder, the file will be overwritten.

Code: 
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] DownloadImages()

    [COLOR=darkblue]Dim[/COLOR] sURL [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] sDestPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] sDestFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'Turn off screen updating[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=green]'Set the path to the destination folder (change accordingly)[/COLOR]
    sDestPath = "C:\Users\Domenic\Desktop\"
    [COLOR=darkblue]If[/COLOR] Right(sDestPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR]
        sDestPath = sDestPath & "\"
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    [COLOR=green]'Find the last used row in Column A[/COLOR]
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [COLOR=green]'Loop through each cell in Column A starting at Row 2[/COLOR]
    [COLOR=darkblue]For[/COLOR] i = 2 [COLOR=darkblue]To[/COLOR] LastRow
        [COLOR=green]'Check whether cell constains a hyperlink[/COLOR]
        [COLOR=darkblue]If[/COLOR] Cells(i, "A").Hyperlinks.Count > 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=green]'Get the URL from the current cell[/COLOR]
            sURL = Cells(i, "A").Hyperlinks.Item(1).Address
            [COLOR=green]'Call function to download the URL file to the destination folder[/COLOR]
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] SaveWebFile(sURL, sDestPath & Mid(sURL, InStrRev(sURL, "/") + 1)) [COLOR=darkblue]Then[/COLOR]
                [COLOR=green]'If URL file isn't found, mark the corresponding cell in Column B as N/A (optional)[/COLOR]
                Cells(i, "B").Value = "N/A"
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    [COLOR=green]'Turn on screen updating[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
    MsgBox "Completed!", vbInformation
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]


[COLOR=darkblue]Function[/COLOR] SaveWebFile(sURL [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], sDestinationFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]

    [COLOR=darkblue]Dim[/COLOR] oXMLReq [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] oResp() [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Byte[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] FileNum [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'Create an instance of the XML object[/COLOR]
    [COLOR=darkblue]Set[/COLOR] oXMLReq = CreateObject("MSXML2.XMLHTTP")
    
    [COLOR=darkblue]With[/COLOR] oXMLReq
        [COLOR=green]'Open a socket to get the URL[/COLOR]
        .Open "GET", sURL, [COLOR=darkblue]False[/COLOR]
        [COLOR=green]'Send the request[/COLOR]
        .send
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    [COLOR=green]'Check whether the request has been successful (200 = OK)[/COLOR]
    [COLOR=darkblue]If[/COLOR] oXMLReq.Status <> 200 [COLOR=darkblue]Then[/COLOR]
        SaveWebFile = [COLOR=darkblue]False[/COLOR]
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Function[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    [COLOR=green]'Get the response from the request (returns a byte array)[/COLOR]
    oResp = oXMLReq.responseBody
    
    [COLOR=green]'Download the file to the destination[/COLOR]
    FileNum = FreeFile
    [COLOR=darkblue]Open[/COLOR] sDestinationFile [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Binary[/COLOR] [COLOR=darkblue]As[/COLOR] [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] 
        Put [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] , , oResp
    [COLOR=darkblue]Close[/COLOR] [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum"]#FileNum[/URL] 
    
    [COLOR=green]'Clear from memory[/COLOR]
    [COLOR=darkblue]Set[/COLOR] oXMLReq = [COLOR=darkblue]Nothing[/COLOR]
    
    SaveWebFile = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
 
Last edited:
Upvote 0
29sandesh said:
Column A contains urls, need vba module to download the images from these urls/hyperlinks to desktop. The below link has been converted to hyperlink in excel

http://i723.photobucket.com/albums/ww237/sukkhi2/Stock 23/Stock 23 Remaining/26ALPHAZ340_zpssoxAB3fbh.jpg

<tbody>
</tbody>
Click to expand...

Sorry but this aint working, it gives a completed pop up but no files in folder.
 
Upvote 0
After running the code, do you get "N/A" in the corresponding cells in Column B? If so, it means that the urls are not being found. In fact, I'm unable to access the one you posted using my web browser.
 
Upvote 0
Nope n/a is not showing up. the hyperlinks are working fine as there are around 300 of 'em and i tried with another code on mrexcel but that code also renames the images which we dont want, can share the code which for me might need a bit tweaking
 
Upvote 0
It looks like the urls are not being recognized as hyperlinks. Does it help if you replace For/Next with...

Code: 
    'Loop through each cell in Column A starting at Row 2
    For i = 2 To LastRow
        'Get the URL from the current cell
        sURL = Cells(i, "A").Value
        'Call function to download URL file to the destination file
        If Not SaveWebFile(sURL, sDestPath & Mid(sURL, InStrRev(sURL, "/") + 1)) Then
            'If URL file isn't found, mark the corresponding cell in Column B as N/A
            Cells(i, "B").Value = "N/A"
        End If
    Next i

???
 
Upvote 0
Domenic said:
It looks like the urls are not being recognized as hyperlinks. Does it help if you replace For/Next with...

Code: 
    'Loop through each cell in Column A starting at Row 2
    For i = 2 To LastRow
        'Get the URL from the current cell
        sURL = Cells(i, "A").Value
        'Call function to download URL file to the destination file
        If Not SaveWebFile(sURL, sDestPath & Mid(sURL, InStrRev(sURL, "/") + 1)) Then
            'If URL file isn't found, mark the corresponding cell in Column B as N/A
            Cells(i, "B").Value = "N/A"
        End If
    Next i

???
Click to expand...
oh you genius it worked like magic, thanks a ton :cool:
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question
Macro to download zip, unpack and copy data
Replies
0
Views
98
HeinrichPaul
H
netspeedz
  • Solved
Load Image in User Form - 64bit Excel [VBA]
Replies
6
Views
403
netspeedz
netspeedz
O
  • Solved
Unable to download html data from specific site
Replies
7
Views
122
Edgar_
Edgar_
Anigito
  • Question
Get Webpage Title Text by URL Generated in MS Excel
Replies
1
Views
450
Anigito
Anigito
F
  • Question
Convert a OneDrive path to the local path
Replies
2
Views
427
FryGirl
F

Forum statistics

Threads
1,215,200
Messages
6,123,601
Members
449,109
Latest member
Sebas8956

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top