使用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