[已解决]抓取网页中左边的信息

lslly

抓取申通信息.rar (26.48 KB, 下载次数: 16)

2016-8-26 17:31 上传

点击文件名下载附件

哪位大神指导下

最佳答案

月排行榜 / 总排行榜

ghostjiao

2016-8-31 14:25

1. Sub aa()
   
2.     Dim html As Object, uls As Object, ul As Object, li As Object, div As Object
   
3.     Dim i As Integer, j As Integer, arr(1 To 100, 1 To 5)
   
4.     Const url As String = "http://q1.sto.cn/chaxun/result?express_no=402059104241"
   
5.     Dim str As String
   
6.     With CreateObject("winhttp.winhttprequest.5.1")
   
7.         .Open "GET", url, False
   
8.         .send
   
9.        Set html = CreateObject("htmlfile")
   
10.        html.body.innerhtml = .responseText
    
11.        Set uls = html.all.tags("ul")
    
12.        For Each ul In uls
    
13.             If ul.classname = "result-list-info" Then
    
14.                 For i = 2 To ul.Children.Length - 1
    
15.                     Set li = ul.Children(i)
    
16.                     For j = 0 To li.Children.Length - 1
    
17.                         arr(i - 1, j + 1) = li.Children(j).innertext
    
18.                     Next
    
19.                 Next
    
20.             End If
    
21.        Next
    
22.     End With
    
23.     Range("a1").Resize(i - 1, 2) = arr
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

爱疯

Sub getWebPage()
    Dim HTML, lis, i
    Set HTML = CreateObject("htmlfile")
    HTML.body.innerhtml = GetSource("http://q1.sto.cn/chaxun/result?express_no=402059104241")
    Set lis = HTML.ALL.tags("li")
    Range("a:a").ClearContents
    For i = 15 To 24
        Cells(i - 14, 1) = Left(lis(i).innertext, 19)
    Next i
End Sub

'功能：获取网页代码
Private Function GetSource(sURL As String)
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", sURL, False
    oXHTTP.Send
    GetSource = oXHTTP.responsetext
    Set oXHTTP = Nothing
End Function
抓取申通信息2.rar (30.62 KB, 下载次数: 5)

2016-8-31 09:35 上传

点击文件名下载附件


不大会，写死了，从15到24

ghostjiao

1. Sub aa()
   
2.     Dim html As Object, uls As Object, ul As Object, li As Object, div As Object
   
3.     Dim i As Integer, j As Integer, arr(1 To 100, 1 To 5)
   
4.     Const url As String = "http://q1.sto.cn/chaxun/result?express_no=402059104241"
   
5.     Dim str As String
   
6.     With CreateObject("winhttp.winhttprequest.5.1")
   
7.         .Open "GET", url, False
   
8.         .send
   
9.        Set html = CreateObject("htmlfile")
   
10.        html.body.innerhtml = .responseText
    
11.        Set uls = html.all.tags("ul")
    
12.        For Each ul In uls
    
13.             If ul.classname = "result-list-info" Then
    
14.                 For i = 2 To ul.Children.Length - 1
    
15.                     Set li = ul.Children(i)
    
16.                     For j = 0 To li.Children.Length - 1
    
17.                         arr(i - 1, j + 1) = li.Children(j).innertext
    
18.                     Next
    
19.                 Next
    
20.             End If
    
21.        Next
    
22.     End With
    
23.     Range("a1").Resize(i - 1, 2) = arr
    
24. End Sub
    

复制代码

爱疯

Sub getWebPage()
    Dim HTML, divs, i, s
    Set HTML = CreateObject("htmlfile")
    HTML.body.innerhtml = GetSource("http://q1.sto.cn/chaxun/result?express_no=402059104241")
    Set divs = HTML.ALL.tags("div")
    Range("a:a").ClearContents
    For i = 0 To divs.Length - 1
        If divs(i).classname = "fl-left" Then s = s + 1: Cells(s, 1) = divs(i).innertext
    Next i
End Sub

'功能：获取网页代码
Private Function GetSource(sURL As String)
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    oXHTTP.Open "GET", sURL, False
    oXHTTP.Send
    GetSource = oXHTTP.responsetext
    Set oXHTTP = Nothing
End Function


最后，删掉多的1个...