Reputation: 1
I have an excel sheet with 2 columns, A and B. Column A has a name, and column B has the image URL.
I want to download all the images and have them renamed to what's in column A. I've searched on here and it appears that there has been a previous solution, but the code doesn't work on my version of excel/PC as I get an error:
"Compile Error
The code in the project must be updated for use on 64 bit systems. Please review and update Declare statements then mark them with the PtrSafe Attribute".
Here's the previous post: GET pictures from a url and then rename the picture
Would appreciate and love any help regarding this!
Upvotes: 0
Views: 18559
Reputation: 61860
The following Sub
should do the same as the one in GET pictures from a url and then rename the picture. But since it does not uses system functions but only native Excel VBA, it should be independent of whether 32-bit or 64-bit Office is used.
The Sheet1
:
The code:
Const FolderName As String = "P:\Test\"
Sub downloadJPGImages()
Set ws = ActiveWorkbook.Sheets("Sheet1")
lLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
Set oBinaryStream = CreateObject("ADODB.Stream")
adTypeBinary = 1
oBinaryStream.Type = adTypeBinary
For i = 2 To lLastRow
sPath = FolderName & ws.Range("A" & i).Value & ".jpg"
sURI = ws.Range("B" & i).Value
On Error GoTo HTTPError
oXMLHTTP.Open "GET", sURI, False
oXMLHTTP.Send
aBytes = oXMLHTTP.responsebody
On Error GoTo 0
oBinaryStream.Open
oBinaryStream.Write aBytes
adSaveCreateOverWrite = 2
oBinaryStream.SaveToFile sPath, adSaveCreateOverWrite
oBinaryStream.Close
ws.Range("C" & i).Value = "File successfully downloaded as JPG"
NextRow:
Next
Exit Sub
HTTPError:
ws.Range("C" & i).Value = "Unable to download the file"
Resume NextRow
End Sub
Upvotes: 9