从URL下载图像并重命名

我有一个Excel表，有2列，A和B.列A有一个名称，列B有图像的URL。

我想下载所有的图像，并将它们重新命名为A列中的内容。我已经在这里search，看起来有一个以前的解决scheme，但代码不适用于我的版本的Excel / PC，因为我得到一个错误：

“编译错误

项目中的代码必须更新以在64位系统上使用。 请检查并更新Declare语句，然后用PtrSafe属性标记它们“。

这是以前的post： 从url获取图片，然后重命名图片

将不胜感激，并爱这方面的帮助！

Answer 1

下面的Sub应该和url中的GET图片一样，然后重命名图片 。 但是，由于它不使用系统function，而只使用本地Excel VBA，因此应该与是否使用32位或64位Office无关。

Sheet1 ：

代码：

 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