网络数据采集问题

风中漫步

这个是比较有代表性的网页,请看:http://www.chinatax.gov.cn/n810214/n810621/n810668/index.html,是税务总局的,请放心查看

需要采集标题和连接.
不使用浏览器组件,直接从源码中提取.因为组件比较依赖平台,所以尽量不用.

目前想到的问题:
1.如何得到总页数
2.如何翻页
3.如何提取标题和连接

请大神指教,谢谢

风中漫步

最好用正则提取,不使用DCOM(好象是叫这个名字,就是分析HTML的那个)

roych

关于网页抓取，我研究不多，不过还是说两句吧。网页抓取主要依靠2种方式：
1、使用webbrowser或者IE组件装载页面后，通过CSS选择器（Selector）来读取数据。
2、发送HTTPRequest请求（深层次则属于Ajax技术），对返回源码进一步处理。
所谓的“正则提取”，只是对源码字符串进行处理的一个手段罢了，谈不上核心技术。事实上，如果不喜欢正则，或者觉得正则表达式测试麻烦的话，也可以用substring（js），instr（vb）之类的函数来处理。
--------------------------------------
说完这些，现在可以来回答这几个问题了：
1和2：通过对源码的分析，应该是先读取内容页列表，然后使用HTTPRequest来发送请求来获取源码，再通过自定义函数createrul来创建链接以及按模板写成页面。因此读取页码或者翻页，只需要先读取内容页列表即可完成。不过里面的脚本文件一对代码，而且是压缩过的。我实在没兴趣，你可以自行下载附件研究。
3：标题和超链接的问题，其实你已经提出解决方案了：那就是正则表达式。

todaynew

1、总页数取id为pag_831221的innerHTML；
2、翻页就是导航到某个地址，该地址为：
url="../../../n810214/n810621/n810668/index_831221_{x}.html"
用1、2、3...分别替换{x}即可翻页；
3、遍历id为comp_831221中的dd标签即可得到标题和链接。

风中漫步

roych 发表于 2016-6-20 10:23
关于网页抓取，我研究不多，不过还是说两句吧。网页抓取主要依靠2种方式：
1、使用webbrowser或者IE组件装 ...

多谢斑竹解答及提供的资料

todaynew

风中漫步 发表于 2016-6-20 13:25
多谢斑竹解答及提供的资料

Private Function GetText() As Variant
    '功能：从税务总局网页提取地址和项目名称
    Dim xmlhttp As Object
    Dim url As String
    Dim txt As String
    Dim Arr, i
    Dim A()
    url = "http://www.chinatax.gov.cn/n810214/n810621/n810668/index.html"

    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
    With xmlhttp
        .Open "GET", url, False
        .send
        txt = .responsetext
    End With
    txt = Mid(txt, InStr(txt, "<dd>"))
    txt = Left(txt, InStrRev(txt, "</dd>") + 4)
    txt = Replace(txt, "<dd class=" & Chr(34) & "sv_linel" & Chr(34) & "></dd>", "")
    Arr = MatchArr(txt, "<.*>")

    If Arr(0) = "True" Then
        For i = 1 To UBound(Arr)
            ReDim Preserve A(1, i - 1)
            A(0, i - 1) = Mid(Arr(i), InStr(Arr(i), Chr(34)) + 1)
            A(0, i - 1) = Left(A(0, i - 1), InStr(A(0, i - 1), Chr(34)) - 1)
            A(0, i - 1) = Replace(A(0, i - 1), "../../..", "http://www.chinatax.gov.cn")

            A(1, i - 1) = Mid(Arr(i), InStr(Arr(i), "</span>") + 7)
            A(1, i - 1) = Left(A(1, i - 1), InStr(A(1, i - 1), "</a") - 1)
        Next
    End If
    GetText = A
End Function


Public Function MatchArr(ByVal s As String, ByVal match_str As String) As Variant
    '引用：Microsoft VBScript Regular Expressions 5.5
    '功能：返回与正则表达式中捕获的子字符串
    '参数：s--字符串,match_str--正则表达式
    '示例：A=MatchArr(str,"sum\(v\(\d+,\d+,\d+\):v\(\d+,\d+,\d+\)\)")
    Dim re As New regexp
    Dim m As Match
    Dim objs As MatchCollection
    Dim A()
    Dim i As Long, j As Long
    re.Pattern = match_str
    re.IgnoreCase = True
    re.Global = True
    ReDim A(0)
    A(0) = CStr(re.Test(s))
    If re.Test(s) = True Then
        Set objs = re.Execute(s)
        ReDim Preserve A(objs.Count)
        i = 0
        For Each m In objs
            i = i + 1
            A(i) = m.Value
        Next
    End If
    MatchArr = A
    Set re = Nothing
    Set m = Nothing
    Set objs = Nothing
End Function