从 URL 下载图像并重命名

Question

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

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

“编译错误

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

这是上一篇文章：从 url 获取图片，然后重命名图片

将不胜感激并喜欢任何与此相关的帮助！

Answer 1

下面的操作应该与从 url 获取图片Sub中的操作相同，然后重命名该图片。但由于它不使用系统函数而仅使用本机 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