vba抓取网页数据( PS:此方法会打开浏览器读取数据，不然可能会跳出错误)

　　vba抓取网页数据(

PS:此方法会打开浏览器读取数据，不然可能会跳出错误)

　　<a id="1_CreateObjectInternetExplorerApplication_0"></a>方法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 是不可见的，其实是在后台操作的。并且需要等待浏览器返回数据的时间，否则可能会报错。

　　方法二：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

　　附注：

　　1、该方法中，如果P标签中有汉字，则返回码为乱码，

　　2、使用WPS用户访问外部网站会弹出安全通道的错误，不会出现LAN URL。这个问题暂时无法解决。

　　

　　方法三：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

　　附注：

　　1、msxml2可以自动适应乱码问题，兼容性强。

　　2、 缺点 对于已经访问过的网站，如果网站中更新的内容还是旧数据。 msxml2的原因是上次读取缓存数据引起的。

　　解决方案：在运行程序前清除浏览器缓存。使用：Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"。如果不行，请自行测试其他方法。评论和方法纯属个人理解，错误难免。

　　Sub Clear_Temp_Files()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 " &#39;清除临时文件

End Sub

Sub Clear_Cookies()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2" &#39;清除Cookies

End Sub

Sub Clear_History()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1" &#39;清除历史记录

End Sub

Sub Clear_Form_Data()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 16" &#39;清除表单数据

End Sub

Sub Clear_Saved_Passwords()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 32" &#39;清除记住的账号密码

End Sub

Sub Clear_All()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255" &#39;清除所有

End Sub

Sub Clear_Clear_Add_ons_Settings()

Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 4351" &#39;清除创建默认设置

End Sub

　　方法四：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

　　附注：

　　1、与方法3基本相同，唯一不同的是这种方法不会造成数据缓存问题，并且保证读取的数据是最新的。

　　2、同方法2问题，WPS用户访问外部网站会跳出安全通道错误，不会出现LAN URL。这个问题暂时没有解决方案

　　解决CreateObject("WinHttp.WinHttpRequest.5.1")中乱码问题

　　Function UrlFile(Url, Ucode) &#39;获取网页源文件(网址,编码)

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 &#39;通过判断"content-type"是否有"charset"字符串来决定是否根据参数2转码(文本比较——不区分大小写)

UrlFile = oServerXmlHttp.responseText

Else

Set ObjStream = CreateObject("Adodb.Stream") &#39;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

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

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

　　方法二：CreateObject("WinHttp.WinHttpRequest.5.1") 方法三：CreateObject("msxml2.xmlhttp") 方法四：CreateObject("Msxml2.ServerXMLHTTP" )

　　后来发现是oDom有问题，当oDom.body.innerHTML = .ResponseText数据被转换时就会发生这种情况。

　　解决方案：

　　不要使用oDOM，使用正则表达式获取值，如果我想获取所有P标签的值，如下

　　Part = .responseText

Set re = CreateObject("VBScript.RegExp")

re.Pattern = "(.*?)"

&#39;re.Pattern = "p>.*[\s\S]*