VBA如何下载这两个链接的图片？

zhanglei1371

各位大佬，求助下关于图片下载的问题：
我用如下代码：

[Visual Basic] 纯文本查看 复制代码

Sub 网络图片下载测试()
    Dim fileLink As String
    Dim saveFilePath As String
    Dim http As Object
    Dim stream As Object
    Dim contentType As String
    fileLink = "https://img2.baidu.com/it/u=2430257832,456548366&fm=253&fmt=auto?w=800&h=1067" '这个可以成功
    saveFilePath = "C:\image3.png"
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", fileLink, False
    http.Send
    If http.Status = 200 Then
        Set stream = CreateObject("ADODB.Stream")
        stream.Type = 1
        stream.Open
        stream.Write http.ResponseBody
        stream.SaveToFile saveFilePath, 2 ' 2 = adSaveCreateOverWrite
        stream.Close
        MsgBox "文件下载成功！", vbInformation
    Else
        MsgBox "下载失败，状态码：" & http.Status, vbCritical
    End If
    Exit Sub
End Sub

上面代码下载filelink是没问题的。
但是下载这两个就不行了（能下载下来，但是打不开，似乎文件头坏掉了），不知该如何修改？谢谢！
https://fb.fenbike.cn/api/tarzan/images/1495b81ea9efe71.png
https://fb.fenbike.cn/api/tarzan/images/1606970828a5b5a.png

kilkilo502

不知道哈哈不过我看这个图片怎么感觉像是考国家公安系统里面的那些题呢

你好，再见

第二张图片没问题，第一个有问题，并且损坏的文件并不是原图片的一部分，可能是网站cdn缓存的问题呢？

zhanglei1371

你好，再见 发表于 2025-2-9 21:53
第二张图片没问题，第一个有问题，并且损坏的文件并不是原图片的一部分，可能是网站cdn缓存的问题呢？


...

但是浏览器打开查看是正常的，很奇怪，难道是网站保护机制么？

xianyuge

坐等答案，期待大佬解答

小能维尼

通过询问ChatGPT，不难得出：

分析两种 URL 的行为

1. url1 = "https://fb.fenbike.cn/api/tarzan/images/1495b81ea9efe71.png" 失败的可能原因
   • URL 访问限制：这个 URL 可能需要身份验证（如 Token、Cookie 等）才能访问，而 Pictures.Insert 方法无法处理这些验证机制。
   • 防盗链机制：服务器可能配置了 Referer 限制，只有特定来源（如网页浏览器）能访问，而 VBA 直接请求时被拒绝。
   • 响应头问题：服务器可能返回了 Content-Disposition: attachment，导致 VBA 不能正确解析为图片。
   • HTTPS 证书问题：如果服务器的 SSL 证书不受 Windows 受信任的根证书支持，VBA 可能无法下载图片。
2. url2 = "https://img2.baidu.com/it/u=2430257832,456548366&fm=253&fmt=auto?w=800&h=1067" 能正确返回
   • URL 可公开访问：这个 URL 直接指向一个可访问的图片文件，VBA 可以正常下载。
   • 无身份验证：百度图片服务器对公共访问没有身份认证要求。
   • 正确的 Content-Type：百度图片服务器返回的 Content-Type 可能是 image/png 或 image/jpeg，Excel 能正确解析。

含有保存到本地，并且插入到Excel中，代码如下：

[Visual Basic] 纯文本查看 复制代码

Sub InsertImageFromUrl()
    Dim url As String
    Dim http As Object
    Dim stream As Object
    Dim filePath As String
    
    url = "https://fb.fenbike.cn/api/tarzan/images/1495b81ea9efe71.png"
    
    ' 创建 XMLHTTP 对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", url, False
    http.Send
    
    ' 检查请求是否成功
    If http.Status = 200 Then
        ' 创建 ADODB.Stream 对象
        Set stream = CreateObject("ADODB.Stream")
        stream.Type = 1 ' 二进制数据
        stream.Open
        stream.Write http.responseBody
        
        ' 设置临时文件路径
        filePath = ThisWorkbook.Path & "\temp_image.png"
        
        ' 保存到本地文件
        stream.SaveToFile filePath, 2
        stream.Close
        
        ' 在 Excel 中插入图片
        ActiveSheet.Pictures.Insert filePath
    Else
        MsgBox "下载失败: " & http.Status, vbCritical
    End If
    
    ' 清理对象
    Set http = Nothing
    Set stream = Nothing
End Sub

zhanglei1371

小能维尼 发表于 2025-2-10 09:06
通过询问ChatGPT，不难得出：

[md]### **分析两种 URL 的行为**

chatGPT解决不了的 ，你发的代码和我发的没啥区别，都是下载后打不开。

小能维尼

zhanglei1371 发表于 2025-2-10 09:18
chatGPT解决不了的 ，你发的代码和我发的没啥区别，都是下载后打不开。

我正常打开啊

小能维尼

zhanglei1371 发表于 2025-2-10 09:18
chatGPT解决不了的 ，你发的代码和我发的没啥区别，都是下载后打不开。

不信看视频，有图有真相
Onedrive链接，需要特殊访问技巧：https://1drv.ms/v/s!Akf7qU3Io2Y3h8BeztJdYnxKZKoSew?e=eSoc2e

whyzl20

我尝试了一下，确实有问题。坐等大佬答疑。