求助VBA抓取网页信息

Question

Sub test()
    Set oDoc = CreateObject("htmlfile")
    Cells.Clear
    [A1:O1] = Array("注册号", "产品名称", "生产单位", "地址", "产品标准", "产品性能结构及组成", "产品适用范围", "规格型号", "批准日期", "有效期", "变更日期", "生产场所", "邮编", "附件", "备注")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For i = 1 To 30
            .Open "GET", "http://app1.sfda.gov.cn/datasearch/face3/content.jsp?tableId=26&tableName=TABLE26&tableView=国产器械&Id=" & i, False
            .Send
            oDoc.Body.innerHTML = .responsetext
            Set r = oDoc.All.tags("table")(0).Rows
            For m = 1 To r.Length - 1
                Cells(i + 1, m) = r(m).Cells(1).innerText
            Next m
        Next i
    End With
End Sub

Answer 1

判断一下呗，没有数据了就用exit for跳出循环。

Answer 2

加一句：On Error Resume Next
Sub test()
    Set oDoc = CreateObject("htmlfile")
    Cells.Clear
    On Error Resume Next
    [A1:O1] = Array("注册号", "产品名称", "生产单位", "地址", "产品标准", "产品性能结构及组成", "产品适用范围", "规格型号", "批准日期", "有效期", "变更日期", "生产场所", "邮编", "附件", "备注")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        For i = 4679 To 4681
            .Open "GET", "http://app1.sfda.gov.cn/datasearch/face3/content.jsp?tableId=26&tableName=TABLE26&tableView=国产器械&Id=" & i, False
            .Send
            oDoc.Body.innerHTML = .responsetext
            Set r = oDoc.All.tags("table")(0).Rows
            For m = 1 To r.Length - 1
                Cells(i + 1, m) = r(m).Cells(1).innerText
            Next m
        Next i
    End With
End Sub