怎么用表格抓取指定的网页链接下图片的链接并输出图片链接

宏初学者

如何抓取指定网页中图片的链接

我是来讨说法的

没人弄了你可以找我哈Q244370061

perfect131

2楼上大神对不住了，仅供参考
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
'Const wq As Long = 10
Sub kong()
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    On Error Resume Next
    Dim surl, strUrl1
    Dim w, b, j, wq
    wq = ActiveSheet.Cells(Rows.Count, "a").End(3).Row
    w = 2
    b = 0
    j = 1
    Dim arr(1 To 1000, 1 To 2)
    Do While w < wq + 1
   
'        降低访问次数
'        Sleep 20

        If ActiveSheet.Cells(w, 1) <> "" Then
            surl = ActiveSheet.Cells(w, 1)
            With xmlHttp
                .Open "GET", surl, False
                .Send
                Do While xmlHttp.readyState <> 4
                    DoEvents
                Loop
                strUrl1 = StrConv(.responsebody, vbUnicode)
                Dim s() As String
                s = Split(StrConv(.responsebody, vbUnicode), "{""hiRes"":")
                Dim a
                If Split(s(1), ",""")(0) <> "null" Then
                    a = 1
                    Do While a < UBound(s) + 1
                        arr(j, 1) = Split(Split(s(a), """")(1), """,""")(0)
                        arr(j, 2) = surl
                        j = j + 1
                        a = a + 1
                    Loop
                End If
                If Split(s(1), ",""")(0) = "null" Then
                    a = 1
                    Do While a < UBound(s) + 1
                        arr(j, 1) = Split(Split(s(a), "large"":""")(1), """,""")(0)
                        arr(j, 2) = surl
                        j = j + 1
                        a = a + 1
                    Loop
                End If
            End With
            Erase s()
        End If
        w = w + 1
    Loop
    ActiveSheet.Range("c2").Resize(UBound(arr), 2) = arr
End Sub

宏初学者

perfect131 发表于 2021-5-11 10:43
2楼上大神对不住了，仅供参考
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds ...

感谢感谢，厉害