Excel vba 网抓百度搜索结果

最近在录制Excel vba网抓教程，弄了一个网抓百度搜索结果的例子，分享一下。（注意：网抓是有时效性的，如果下面代码无法生效，请评论回复提醒我一下，谢谢。）

百度搜索的url参数，主要有三个：

1、wd，必填，搜索关键字

2、rn，可选，每页显示的搜索结果数量，范围1-50

3、pn，可选，当前页码，从0开始计数，需要用页码乘以rn

例如，搜索“杨仕航的博客”，每页显示20条记录，查看第2页。请求的链接如下：

https://www.baidu.com/s?wd=杨仕航的博客&rn=20&pn=20

写了两个过程，分别是获取搜索结果数量和结果列表

'获取搜索结果数量(在立即窗体输出结果，你可以改成Function返回结果)'
'参数说明：'
'   strWord：关键字'
'使用示例：GetSearchNum "杨仕航的博客"'
Public Sub GetSearchNum(strWord As String)
    '创建XMLHttp对象'
    With CreateObject("MSXML2.XMLHTTP")
        '构建并发送请求'
        .Open "GET", "https://www.baidu.com/s?wd=" & strWord & "&rn=1", False
        .send
        
        '等待响应'
        Do While .readyState <> 4
            DoEvents
        Loop
        
        '处理响应结果'
        Dim strNum As String
        strNum = Split(Split(.ResponseText, "百度为您找到相关结果")(1), "<")(0)
    End With
    
    Debug.Print "关键字：" & strWord & vbCrLf & "百度为您找到相关结果" & strNum
End Sub

'获取百度搜索列表(结果输出到当前表格的A列和B列)'
'参数说明：'
'   strWord：关键字'
'   lngNum：每页条数，1-50'
'   lngPage：第几页的数据，从0开始计数'
'使用示例：GetSearchList "杨仕航的博客"'
Public Sub GetSearchList(strWord As String, Optional lngNum As Long = 10, Optional lngPage As Long = 0)
    Dim s() As String, arr(), i As Long
    [a:b].ClearContents '清除数据'
 
    '创建XMLHttp对象'
    With CreateObject("MSXML2.XMLHTTP")
        '构建并发送请求'
        .Open "GET", "https://www.baidu.com/s?wd=" & strWord & "&rn=" & lngNum & "&pn=" & lngNum * lngPage, False
        .send
        
        '等待响应'
        Do While .readyState <> 4
            DoEvents
        Loop
 
        '处理响应结果 每个搜索结果a标签前面都有h3标签，以此为分组依据'
        s = Split(.ResponseText, "<h3 class=""t")
        ReDim arr(UBound(s), 1)
        
        arr(0, 0) = "标题"
        arr(0, 1) = "链接"
        
        For i = 1 To UBound(s)
            '这个是比较长，主要是获取对应的标题。其中包含去掉em标签等内容'
            arr(i, 0) = Trim(Split(Replace(Replace(Replace(Split(Split(s(i), "")(0), "target=""_blank""")(1), "", ""), "", ""), Chr(10), ""), ">")(1))
            '获取对应的链接'
            arr(i, 1) = Split(Split(s(i), "<a href=""")(1), """")(0)
        Next
    End With
    [A1:B1].Resize(UBound(arr) + 1) = arr
End Sub

最后面那些split和replace是处理响应的数据，获取对应的结果。分析过程太长了，写出来会很长篇幅。想了解详细分析过程，可以看我的网抓教程里面具体讲解。（教程可能还没上线，大概2016年3月份会上线）

2016-2-5 修改http为https，http模式百度已经把wd参数改成word，导致无法使用。