从URL下载图像并重命名

Question

我有一个包含2列A和B的Excel工作表。列A有一个名称，B列有图像URL。

我想下载所有图片，并将它们重命名为A栏中的内容。我在这里搜索过，似乎有一个以前的解决方案，但代码不适用于我的excel版本/ PC因为我收到错误：

“编译错误

必须更新项目中的代码才能在64位系统上使用。请查看并更新Declare语句，然后使用PtrSafe属性“。

标记它们

以上是上一篇文章：GET pictures from a url and then rename the picture

非常感谢并喜欢这方面的任何帮助！

Answer 1

以下Sub应与GET pictures from a url and then rename the picture中的Sheet1相同。但由于它不使用系统功能而只使用本机Excel VBA，因此它应该与是否使用32位或64位Office无关。

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 ：

代码：

{{1}}