vba怎么将表格里的图片链接自动下载到指定的本地文件夹里

dong130

vba怎么将表格里的图片链接自动下载到指定的本地文件夹里，A列为图片链接，B列为自命名图片名称

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, n&, strPath$, strFileName$
   
    Application.DisplayAlerts = False
    ar = [A1].CurrentRegion.Value
    strPath = ThisWorkbook.Path & "\"
    For i = 2 To UBound(ar)
        strFileName = strPath & ar(i, 2) & ".jpg"
        If DownloadImage(CStr(ar(i, 1)), strFileName) = True Then
            n = n + 1
        End If
    Next i
   
    Application.DisplayAlerts = True
    MsgBox "共下载" & n & "张图片！"
    Beep
End Sub
Function DownloadImage(strUrl As String, strFileName As String) As Boolean
    Dim httpReq As Object
    On Error GoTo ErrorHandler
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    With httpReq
        .Open "GET", strUrl, False
        .Send
    End With
    If httpReq.Status = 200 Then
        With CreateObject("ADODB.Stream")
            .Open
            .Type = 1
            .Write httpReq.responseBody
            .SaveToFile strFileName, 2
            .Close
        End With
        DownloadImage = True
    Else
        DownloadImage = False
    End If
    Exit Function
ErrorHandler:
    DownloadImage = False
End Function

gwjkkkkk

。。。。。。。。。。。

dong130

gwjkkkkk 发表于 2024-8-15 20:37
。。。。。。。。。。。

厉害啊，我的哥，感谢感谢

quqiyuan

参与一下，供参考。。。

quqiyuan

代码如下。。。
Sub test()
    arr = Sheet1.Range("a2:b" & Cells(Rows.Count, 1).End(3).Row)
    For i = 1 To UBound(arr)
        Set p = Sheet1.Pictures.Insert(arr(i, 1))
        With p
            .CopyPicture
            w = .Width
            h = .Height
            With ActiveSheet.ChartObjects.Add(0, 0, w, h).Chart
                .Parent.Select
                .Paste
                .Export ThisWorkbook.Path & "\" & arr(i, 2) & ".jpg"
                .Parent.Delete
            End With
        End With
        Sheet1.Pictures.Delete
    Next
End Sub

dong130

quqiyuan 发表于 2024-8-15 22:06
代码如下。。。
Sub test()
    arr = Sheet1.Range("a2:b" & Cells(Rows.Count, 1).End(3).Row)

感谢感谢，谢谢