Vba 从URL下载图像并重命名

我有一个excel表格，有两列，A列和B列。A列有一个名称，B列有图像URL

我想下载所有图像并将其重命名为A列中的内容。我在此处搜索过，似乎有以前的解决方案，但代码在我的excel/PC版本上不起作用，因为我遇到了一个错误：

“编译错误

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

这是之前的帖子：

---

非常感谢并希望得到您的帮助

以下

Sub

应与中的相同。但由于它不使用系统函数，而只使用本机Excel VBA，因此它应该独立于使用32位还是64位Office

表单1

：

守则：

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

---

以下

Sub

应与中的相同。但由于它不使用系统函数，而只使用本机Excel VBA，因此它应该独立于使用32位还是64位Office

表单1

：

守则：

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

---

@Amorpheuses：将您的“64位计算机安装了最新版本的office。”替换为“64位计算机安装了最新32位版本的office”。等等，是否可能是我的Windows版本安装了错误的office版本？我不会将64位office版本称为64位Windows系统的错误版本。但是显式使用

Declare

语句与32位版本不同。看@阿莫菲斯曾表示，他使用64位Windows时，该软件对他有效。但只有在64位Windows中运行32位Office时，这才是真的。我提供了一个不需要系统声明的

子
。因此，这应该与使用32位还是64位Office无关。@Amorpheus:将您的“64位机器安装了最新版本的Office”替换为“64位机器安装了最新32位版本的Office”。等等，是否可能是我为Windows版本安装了错误的office版本？我不会将64位office版本称为64位Windows系统的错误版本。但是显式使用
Declare
语句与32位版本不同。看@阿莫菲斯曾表示，他使用64位Windows时，该软件对他有效。但只有在64位Windows中运行32位Office时，这才是真的。我提供了一个不需要系统声明的
子
。因此，这应该与使用32位还是64位Office无关。