使用vba处理网页爬虫

https://www.sogou.com/link?url=DSOYnZeCC_rR_TP93bdO6GxT14t4sbuOwR4Xg1N-va4KkyI7DJgSnPNx6aHQaobTIeZ8aQ291kY.

 如有侵权，请联系删除

Sub Main()
ActiveSheet.Cells.Clear
Url = "https://www.qppstudio.net/public-holidays-by-date/month1.htm"
Set oHttp = CreateObject("MSXML2.XMLHTTP") '创建一个xmlhttp对象
Set odom = CreateObject("htmlfile") '创建一个Dom对象
With oHttp
'open，创建一个新的http请求，并指定此请求的方法、URL以及验证信息(用户名/密码) 'send,发送请求到http服务器并接收回应 .Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
.Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
.send '将open方法的信息发送给网页服务器
odom.body.innerHTML = .responseText '将响应网页的HTML赋值给Dom对象，并只需要body标签里面的内容
End With
dom (odom)
End Sub

Sub dom(odom As Object)
i = 2
For Each Item In odom.all
If Item.className = "list-item" Then
For Each itemch In Item.Children
If itemch.className = "list-item-heading" Then
Range("a" & i) = itemch.innerText
ElseIf itemch.className = "list-subitem" Then
Range("b" & i) = itemch.Children(1).innerText
Range("c" & i) = itemch.Children(3).innerText
i = i + 1
End If
Next
Exit For
End If
Next
End Sub

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Sub Main()
ActiveSheet.Cells.Clear
Url = "https://www.qppstudio.net/public-holidays-by-date/month1.htm"
Set oHttp = CreateObject("MSXML2.XMLHTTP") '创建一个xmlhttp对象
Set odom = CreateObject("htmlfile") '创建一个Dom对象
With oHttp
'open，创建一个新的http请求，并指定此请求的方法、URL以及验证信息(用户名/密码) 'send,发送请求到http服务器并接收回应 .Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
.Open "GET", Url, False '使用Open方法，用get请求，False代表非异步加载
.send '将open方法的信息发送给网页服务器
odom.body.innerHTML = .responseText '将响应网页的HTML赋值给Dom对象，并只需要body标签里面的内容
End With
dom (odom)
End Sub

Sub dom(odom As Object)
i = 2
For Each Item In odom.all
If Item.className = "list-item" Then
For Each itemch In Item.Children
If itemch.className = "list-item-heading" Then
Range("a" & i) = itemch.innerText
ElseIf itemch.className = "list-subitem" Then
Range("b" & i) = itemch.Children(1).innerText
Range("c" & i) = itemch.Children(3).innerText
i = i + 1
End If
Next
Exit For
End If
Next
End Sub