vba抓网页问题

hbhm

请教大神
1. 当 循环 For qq = 4 To 1 Step -1 qq=4时 ("table")(4) 是空值，会出错。这时应该跳出到qq=3的循环，如何做？
2.  表头取回的是乱码，如何转码？

谢谢！！！！！！！！


Sub sina()
Dim n, ii, jj, y, qq, k As Integer
      For y = Year(Date) To Year(Date) - 2 Step -1
        For qq = 4 To 1 Step -1
Set oDoc = CreateObject("htmlfile")
    With CreateObject("WinHttp.WinHttpRequest.5.1")
            .Open "GET", "http://vip.stock.finance.sina.com.cn/corp/go.php/vMS_MarketHistory/stockid/000001/type/S.phtml?year=" & y & "&jidu=" & qq, False
            .Send
            .WaitForResponse
            oDoc.body.innerHTML = .responsetext
   
        Set r = oDoc.All.tags("table")(4).Rows
            
         For ii = 1 To r.Length - 1
            
             k = k + 1

                For jj = 0 To r(ii).Cells.Length - 1
              
                 Cells(k, jj + 1) = r(ii).Cells(jj).innerText
                Next jj
               
             k = [a65536].End(3).Row
            
         Next ii
   
       Set r = Nothing

    End With
       Next qq
    Next y
   
End Sub

hbhm

请教大神
1. 当 循环 For qq = 4 To 1 Step -1 qq=4时 ("table")(4) 是空值， Set r = oDoc.All.tags("table")(4).Rows 会出错，如何跳出这个出错，跳到循环qq=3 谢谢

YZC51

hbhm 发表于 2017-8-26 09:44
请教大神
1. 当 循环 For qq = 4 To 1 Step -1 qq=4时 ("table")(4) 是空值， Set r = oDoc.All.tags("tab ...

请测试
Sub sina()
    [a2:g1500] = ""
    Dim n, ii, jj, y, qq, k As Integer
    k = 1
    For y = Year(Date) To Year(Date) - 2 Step -1
        For qq = 4 To 1 Step -1
            Set oDoc = CreateObject("htmlfile")
            With CreateObject("Microsoft.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")
                .Open "GET", "http://vip.stock.finance.sina.com.cn/corp/go.php/vMS_MarketHistory/stockid/000001/type/S.phtml?year=" & y & "&jidu=" & qq, False
                .Send
                '   .WaitForResponse
                 V = StrConv(.responseBody, vbUnicode, &H804)
                oDoc.body.innerHTML = V '.responsetext
            End With
            V1 = InStrRev(V, "季度历史交易")
            If V1 < 1 Then GoTo DDD
            Set r = oDoc.All.tags("table")(4).Rows
            For ii = 2 To r.Length - 1
                k = k + 1
                For jj = 0 To r(ii).Cells.Length - 1
                    Cells(k, jj + 1) = r(ii).Cells(jj).innerText
                Next jj
                k = [a65536].End(3).Row
            Next ii
            Set r = Nothing
DDD:
        Next qq
    Next y
End Sub

YZC51

请看看附件
某季度历史交易InStrRev-UTF8.rar (46.06 KB, 下载次数: 8)

2017-10-14 17:35 上传

点击文件名下载附件