VBA爬网页数据

方法1 ：CreateObject(“InternetExplorer.Application”)

Sub 方法1()
LinkStr = "https://www.csdn.net/"
Set ie = CreateObject("InternetExplorer.Application")
With ie
    .Visible = False
    .navigate LinkStr
    Do Until .readystate - 4
        DoEvents
    Loop
     Set oDom = .document
End With
       Debug.Print oDom.getElementsByTagName("p")(0).innertext
End Sub

PS:此方法会打开浏览器读取数据，虽然我们看不到打开浏览器是因为设置的：.Visible = False不可见，实际在后台操作。并且需要等待浏览器返回数据的时间，不然可能会跳出错误。

方法2 ：CreateObject(“WinHttp.WinHttpRequest.5.1”)

Sub 方法2()
LinkStr = "https://www.csdn.net/"

Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
 Set oDom = CreateObject("htmlFile")
With xmlHttp
    .Open "GET", LinkStr, False
    .send
    oDom.body.innerHTML = .ResponseText
End With
Debug.Print oDom.getElementsByTagName("p")(0).innertext
End Sub

PS:
1、此方法如果P标签内为汉字，返回的为乱码，
2、使用WPS用户访问外部网站会跳出安全频道的错误，局域网网址并不会出现，此问题暂时无解。

方法3：CreateObject(“msxml2.xmlhttp”)

Sub 方法3()
Dim oDom As Object
LinkStr = "https://www.csdn.net/"
Set oDom = CreateObject("htmlFile")
Set ms = CreateObject("msxml2.xmlhttp")
With ms
    .Open "GET", LinkStr, True
    .send
    oDom.body.innerHTML = .responseText
End With
Debug.Print oDom.getElementsByTagName("p")(1).innertext
End Sub

PS：
1、msxml2可以自动适应字符乱码问题，兼容性较强。
2、缺点对于对于已经访问的 网站，如果网站内更新的内容，仍然是以前的老数据。原因msxml2是读取的上次缓存的数据才造成的。
解决方案：程序运行前先清空浏览器缓存。使用：Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "。如果不行，请自行测试下其他方式，注释及方法纯个人理解，难免有差错。

Sub Clear_Temp_Files()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 " '清除临时文件
End Sub

Sub Clear_Cookies()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2" '清除Cookies
End Sub

Sub Clear_History()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1" '清除历史记录
End Sub
 
Sub Clear_Form_Data()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 16" '清除表单数据
End Sub

Sub Clear_Saved_Passwords()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 32" '清除记住的账号密码
End Sub
 
Sub Clear_All()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255" '清除所有
End Sub

Sub Clear_Clear_Add_ons_Settings()
Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 4351" '清除创建默认设置
End Sub

方法4： CreateObject(“Msxml2.ServerXMLHTTP”)

Sub 方法3()
Dim oDom As Object
LinkStr = "https://www.csdn.net/"
Set oDom = CreateObject("htmlFile")
Set ms =  CreateObject("Msxml2.ServerXMLHTTP")
With ms
    .Open "GET", LinkStr, False
    .send
    oDom.body.innerHTML = .responseText
End With
Debug.Print oDom.getElementsByTagName("p")(1).innertext
End Sub

PS:
1、与方法3基本一致，唯一不同是加上此方法不会造成数据缓存的问题，保证读取的数据都是最新的。
2、和方法2问题一样WPS用户访问外部网站会跳出安全频道的错误，局域网网址并不会出现，此问题暂时无解

---

解决CreateObject(“WinHttp.WinHttpRequest.5.1”)乱码问题

Function UrlFile(Url, Ucode) '获取网页源文件(网址,编码)
    Dim oServerXmlHttp, ObjStream, oStream
    Set oServerXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    oServerXmlHttp.Open "GET", Url, False
    oServerXmlHttp.send
    oStream = oServerXmlHttp.responseBody
    If Not IsEmpty(oStream) Then
        If InStr(1, oServerXmlHttp.getResponseHeader("content-type"), "charset", 1) Then '通过判断"content-type"是否有"charset"字符串来决定是否根据参数2转码(文本比较——不区分大小写)
            UrlFile = oServerXmlHttp.responseText
        Else
            Set ObjStream = CreateObject("Adodb.Stream") 'With...end with省略对象不可写在判断内
            ObjStream.Type = 1
            ObjStream.Mode = 3
            ObjStream.Open
            ObjStream.Write oStream
            ObjStream.Position = 0
            ObjStream.Type = 2
            ObjStream.Charset = Ucode
            UrlFile = ObjStream.ReadText
        
        End If
    Else
        UrlFile = ""
    End If
    
    Set ObjStream = Nothing: Set oServerXmlHttp = Nothing
End Function


Sub 读取整个网页()
tex = UrlFile("https://www.csdn.net/", "UTF-8")
Debug.Print tex
End Sub

其他问题（获取某个标签的值）

使用以下方法时有时会出现自动打开网页问题：

方法2 ：CreateObject(“WinHttp.WinHttpRequest.5.1”)

方法3：CreateObject(“msxml2.xmlhttp”)

方法4： CreateObject(“Msxml2.ServerXMLHTTP”)

后来发现是oDom在作怪，在oDom.body.innerHTML = .ResponseText数据转换时会发生。
解决方案：
不使用oDOM，使用正则表达式取值,假如我要取所有P标签的值，如下

Part = .responseText
 Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "<p.*>(.*?)</p>"
    're.Pattern = "p>.*[\s\S]*</p"
    re.Global = True
    re.IgnoreCase = False
    Set matchs = re.Execute(OrgStr)
   
    For Each m In matchs
        Debug.Print m.submatches(0) 
    Next
    

完结
如果你感觉还不够，请访问我一老哥的文章希望能帮到你 链接: VBA 网页提取特定内容 - 网抓实践总结.