【求助】这段代码为什么每次都是第一张图

qiulianghui

Sub test()


    Dim s, ss(), r%, i&, j&
    Dim hang As Integer
    Dim Sku As String
    Dim Url1 As String, Url2 As String, Url3 As String
    IName = "img"          '这里确定要下载谁的图片
    Path = ThisWorkbook.Path & "\"
    'MkDir Path & IName        '建立文件夹以便存放图片
    On Error Resume Next
    Set ie = CreateObject("Msxml2.XMLHTTP")
For hang = 116 To 117

        For r = 0 To 1 Step 1  '这里控制你要下载几张网页的图片
           Url1 = "http://item.jd.com/bigimage.aspx?id="
           Url2 = Cells(hang, 5).Value
           Url3 = Url1 + Url2
         ie.Open "GET", Url3
         ie.Send
          Do Until ie.ReadyState = 4
                DoEvents
         Loop                                '等待网页处理完成再运行下面的代码
        s = Split(ie.responseText, """")    '把源文件中的引号替换成换行，以便提取图片链接

        For i = 0 To UBound(s)
            If s(i) Like "http://*.360buyimg.com/*" Then
                If InStr(s(i), "jpg") Then    '这里两行查找含有图片地址的链接
                    j = j + 1
                    ReDim Preserve ss(1 To j)
                    ss(j) = s(i)              '把含有图片地址的链接址传递给数组ss
                End If
            End If
        Next
    Next
    For i = 1 To UBound(ss)
        ie.Open "GET", ss(i), False
        ie.Send
        Do Until ie.ReadyState = 4
            DoEvents
        Loop
        With CreateObject("ADODB.Stream")
            .Type = 1
            .Open
            .write ie.Responsebody
            .savetofile Path & Url2 & ".jpg", 2   '以序号为名称另存图片
            .Close
        End With
        Name Path & Url2 & ".jpg" As Path & IName & "\" & Url2 & ".jpg" '把下载下来的图片移到文件夹中
        Url2 = ""
        Set obj = Nothing
    Next

Next hang
End Sub




表格的第4列 是 商品SKU    比如；   

2090567

qiulianghui

急啊。在线等待啊