爬虫这么火，而你只会vba怎么办？那就用vba啊

爬虫这么火，而你只会vba怎么办？那就用vba啊

來源：https://zhuanlan.zhihu.com/p/30381284

-------------------------------------------



现在爬虫这么火，尤其是用python和R来实现，但是对于不是专业编程人员，平时接触过的语言就只是依赖于office的vba，而我们需要的数据又是来源于网络，那该怎么办呢？其实vba也可以办到爬虫大部分的网页数据。那么我们就来看下应该怎么去写

在看下面的内容之前，建议先看下VBA与网抓，VBA抓取网页数据XMLHTTP对象

需求：将电影名，主演，上映时间，国家，评分等5个信息给提取下来

1.先写出基本架构

Sub maoyanTop100()
        Url = "http://maoyan.com/board/4?offset=0" '猫眼电影top100网址
        Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")  '创建一个xmlhttp对象
        Set oDom = CreateObject("htmlfile") '创建一个Dom对象 
        'XmlHttp对象(MSXML2.XMLHTTP)向http服务器发送请求并使用微软XML文档对象模型Microsoft® XML Document Object Model (DOM)处理回应。 
        With oHttp 
    'open，创建一个新的http请求，并指定此请求的方法、URL以及验证信息(用户名/密码)
     'send,发送请求到http服务器并接收回应

            .Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
            .send '将open方法的信息发送给网页服务器
            oDom.body.innerHtml = .responseText  '将响应网页的HTML赋值给Dom对象，并只需要body标签里面的内容
        End With
End Sub

2.接下来我们要将oDom里面的信息给提取出来

此图截图于网易晕课堂方骥老师的vba课

通过对网页源代码的分析，可以发现，每部电影的信息隐藏在<dd>...</dd>这个标签里的

接下来我们就可以这样子写

Sub maoyanTop100()
        Url = "http://maoyan.com/board/4?offset=0" '猫眼电影top100网址
        Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")  '创建一个xmlhttp对象
        Set oDom = CreateObject("htmlfile") '创建一个Dom对象 
        'XmlHttp对象(MSXML2.XMLHTTP)向http服务器发送请求并使用微软XML文档对象模型Microsoft® XML Document Object Model (DOM)处理回应。 
        With oHttp 
    'open，创建一个新的http请求，并指定此请求的方法、URL以及验证信息(用户名/密码)
     'send,发送请求到http服务器并接收回应

            .Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
            .send '将open方法的信息发送给网页服务器
            oDom.body.innerHtml = .responseText  '将响应网页的HTML赋值给Dom对象，并只需要body标签里面的内容
        End With
        i = 2
        For Each Item In oDom.all
            If Item.tagname = "DD" Then
                Range("a" & i) = Item.Children(1).getAttribute("title") '电影名信息
                Range("b" & i) = Item.Children(2).Children(0).Children(0).Children(1).innerText '主演
                Range("c" & i) = Item.Children(2).Children(0).Children(0).Children(2).innerText  '上映时间和国家
                Range("d" & i) = Item.Children(2).Children(0).Children(1).Children(0).innerText  '评分
                i = i + 1
            End If
        Next
End Sub

通过上面的代码，就可以将一页的所有电影信息都给爬取下来，但是我们要爬取的是100个电影，我们必须将其他网页的信息也可提取下来，通过对网页链接的观察，我们发现，网页是这样一个规律：

所以，我们可以通过循环将所有页面的链接循环一遍，得到最终的代码：

Sub maoyanTop100()
    i = 2
    For n = 0 To 9
        Url = "http://maoyan.com/board/4?offset=" & n * 10
        Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
        Set oDom = CreateObject("htmlfile")
        With oHttp
            .Open "GET", Url, False
            .send
            oDom.body.innerHtml = .responseText
        End With
    
        For Each Item In oDom.all
            If Item.tagname = "DD" Then
                Range("a" & i) = Item.Children(1).getAttribute("title")
                Range("b" & i) = Item.Children(2).Children(0).Children(0).Children(1).innerText
                Range("c" & i) = Item.Children(2).Children(0).Children(0).Children(2).innerText
                Range("d" & i) = Item.Children(2).Children(0).Children(1).Children(0).innerText
                i = i + 1
            End If
        Next
    Next n
    MsgBox "Done ！"
End Sub