VBA抓取网站图片代码执行失败，求获取页面原始图片的方法

你当前代码的核心问题是二次发起GET请求获取图片时，目标站点的图片为动态生成资源（多为验证码类内容），每次请求都会返回新的内容，因此无法拿到首次页面加载时已经渲染完成的原始图片。同时代码存在一个基础错误：<img>标签的资源地址属性是src而非href，这也会导致请求的地址本身无效。

不要重新发起HTTP请求，直接调用IE控件的原生能力，导出已经在页面中加载完成的图片，无需重新和服务器交互，即可拿到和页面显示完全一致的原始图片。

' 64位Office请在Declare后加PtrSafe
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub get_pic()
    Dim img As Object
    Dim shp As Object
    
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "https://igtb.bochk.com/index_tc.html"
        ' 等待主页面加载完成
        Do While .busy
            DoEvents
        Loop
        Do Until .readystate = 4
            DoEvents
            Sleep 2000
        Loop
        ' 额外等待iframe内资源加载完成
        Sleep 3000
        
        ' 获取iframe内的img元素
        Set aaa = .document.all.tags("iframe")(1).contentwindow.document.all.tags("img")
        If aaa.Length = 0 Then
            MsgBox "未找到图片元素"
            .Quit
            Exit Sub
        End If
        
        ' 选中目标图片并复制到剪贴板
        aaa(0).focus
        .document.execCommand "Copy", False, Null
        
        ' 粘贴到工作表中转
        Sheet1.Paste Destination:=Sheet1.Range("A1")
        Set shp = Sheet1.Shapes(Sheet1.Shapes.Count)
        
        ' 导出图片到本地
        SaveShapeAsPic shp, "C:\test.png"
        
        ' 资源清理
        .Quit
        Set .document = Nothing
        Set shp = Nothing
    End With
End Sub

' 形状导出为图片工具函数
Sub SaveShapeAsPic(shp As Object, savePath As String)
    Dim chrt As Object
    Set chrt = ThisWorkbook.Charts.Add
    chrt.ChartArea.Clear
    chrt.ChartArea.Width = shp.Width
    chrt.ChartArea.Height = shp.Height
    shp.Copy
    chrt.Paste
    chrt.Export Filename:=savePath, FilterName:="PNG"
    Application.DisplayAlerts = False
    chrt.Delete
    Application.DisplayAlerts = True
End Sub

• 修正了属性读取错误：将原代码中读取img.href改为img.src，符合HTML标签属性规范
• 移除了XMLHTTP二次请求逻辑，改用execCommand复制页面已加载的图片到剪贴板，避免和服务器重新交互导致图片变更
• 增加了iframe资源加载的额外等待时间，避免资源未加载完成就执行后续逻辑
• 新增了图片导出工具函数，直接将中转的图片导出为本地PNG文件

内容的提问来源于stack exchange，提问作者user16645746