使用 VBA 进行网页抓取
Web Scrapping using VBA
我想使用 VBA 从以下网站提取数据。有人可以帮我写代码吗?
https://experience.arcgis.com/experience/478220a4c454480e823b17327b2bf1d4/page/Bundesl%C3%A4nder/
我有以下代码,但 eColl 对象中没有返回任何内容
Sub filldata()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim eColl As Object
Set ie = New InternetExplorer
''ie.Visible
ie.Navigate ("https://experience.arcgis.com/experience/478220a4c454480e823b17327b2bf1d4/page/Bundesl%C3%A4nder/")
Do
DoEvents
Loop Until ie.ReadyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set eColl = doc.getElementById("ember76")
End Sub
HTML 片段如下:
<div style="left:553.5938335480847px;top:0px;width:92.01991697747864px;height:77.2769437902746px;" id="ember76" class="dock-element ember-view"> <margin-container class="left right top">
<full-container>
<div style="color:#ffffff;" id="ember77" class="widget flex-vertical full-height indicator-widget ember-view"><!---->
<div class="flex-fix widget-header">
<div class="caption">
<h3 style="color:#1a1a1a; height:1px; left:-150px; position:absolute; width:1px">COVID-19 Fälle zum Vortag</h3>
</div>
</div>
<!---->
<div class="flex-justify-center widget-body flex-fluid full-width flex-vertical overflow-y-hidden overflow-x-hidden">
<div class="flex-vertical flex-fix allow-shrink">
<div style="fill:#ffffff" id="ember385" class="flex-fix allow-shrink indicator-top-text responsive-text flex-vertical ember-view"><svg class="responsive-text-group" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0.000005086263172415784 0.3333282470703125 477.1562805175781 80" width="38" height="6.371078248624265">
<g class="responsive-text-icon">
<!---->
</g>
<g class="responsive-text-label">
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -76 572.640625 96" height="80" width="477.20052083333337">
<text vector-effect="non-scaling-stroke" style="fill: rgb(255, 255, 255); stroke-width: 2; font-size: 80px; line-height: normal;">COVID-19-Fälle</text>
</svg>
</g>
</svg></div>
<div style="fill:#ffffff" id="ember386" class="flex-fix allow-shrink indicator-center-text responsive-text flex-vertical ember-view"><svg class="responsive-text-group" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -0.16061308979988098 608.2968139648438 160" width="38" height="9.995120573410386">
<g class="responsive-text-icon">
<!---->
</g>
<g class="responsive-text-label">
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -153 733.765625 193" height="160" width="608.3031088082901">
<text vector-effect="non-scaling-stroke" style="fill: rgb(0, 197, 255); stroke-width: 2; font-size: 160px; line-height: normal;">+209,052</text>
</svg>
</g>
</svg></div>
<!----> </div>
</div>
<!---->
<!----></div>
</full-container>
</margin-container>
</div>
数据由API检索,所以如果你只想要值,你可以尝试直接调用API并排除IE(通常很慢)的需要:
Sub Test()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
With xmlhttp
.Open "GET", "https://services7.arcgis.com/mOBPykOjAyBO2ZKk/arcgis/rest/services/rki_key_data_blbrdv/FeatureServer/0/query?f=json&where=AnzFallNeu%3C%3E0&returnGeometry=false&spatialRel=esriSpatialRelIntersects&outFields=*&orderByFields=AdmUnitId%20asc&resultOffset=0&resultRecordCount=1&resultType=standard&cacheHint=true", False
.Send
Dim regex As Object
Set regex = CreateObject("VbScript.Regexp")
regex.Pattern = """AnzFallNeu"":([\d]{1,}),"
If regex.Test(.responseText) Then
Debug.Print regex.Execute(.responseText)(0).submatches(0)
End If
Set regex = Nothing
End With
Set xmlhttp = Nothing
End Sub
responseText
是一个JSON所以如果你确实需要拉其他数据,你可以考虑使用VBA-JSON而不是Regex
(如图上面的例子)来处理 JSON.
我想使用 VBA 从以下网站提取数据。有人可以帮我写代码吗?
https://experience.arcgis.com/experience/478220a4c454480e823b17327b2bf1d4/page/Bundesl%C3%A4nder/
我有以下代码,但 eColl 对象中没有返回任何内容
Sub filldata()
Dim ie As InternetExplorer
Dim doc As HTMLDocument
Dim eColl As Object
Set ie = New InternetExplorer
''ie.Visible
ie.Navigate ("https://experience.arcgis.com/experience/478220a4c454480e823b17327b2bf1d4/page/Bundesl%C3%A4nder/")
Do
DoEvents
Loop Until ie.ReadyState = READYSTATE_COMPLETE
Set doc = ie.Document
Set eColl = doc.getElementById("ember76")
End Sub
HTML 片段如下:
<div style="left:553.5938335480847px;top:0px;width:92.01991697747864px;height:77.2769437902746px;" id="ember76" class="dock-element ember-view"> <margin-container class="left right top">
<full-container>
<div style="color:#ffffff;" id="ember77" class="widget flex-vertical full-height indicator-widget ember-view"><!---->
<div class="flex-fix widget-header">
<div class="caption">
<h3 style="color:#1a1a1a; height:1px; left:-150px; position:absolute; width:1px">COVID-19 Fälle zum Vortag</h3>
</div>
</div>
<!---->
<div class="flex-justify-center widget-body flex-fluid full-width flex-vertical overflow-y-hidden overflow-x-hidden">
<div class="flex-vertical flex-fix allow-shrink">
<div style="fill:#ffffff" id="ember385" class="flex-fix allow-shrink indicator-top-text responsive-text flex-vertical ember-view"><svg class="responsive-text-group" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0.000005086263172415784 0.3333282470703125 477.1562805175781 80" width="38" height="6.371078248624265">
<g class="responsive-text-icon">
<!---->
</g>
<g class="responsive-text-label">
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -76 572.640625 96" height="80" width="477.20052083333337">
<text vector-effect="non-scaling-stroke" style="fill: rgb(255, 255, 255); stroke-width: 2; font-size: 80px; line-height: normal;">COVID-19-Fälle</text>
</svg>
</g>
</svg></div>
<div style="fill:#ffffff" id="ember386" class="flex-fix allow-shrink indicator-center-text responsive-text flex-vertical ember-view"><svg class="responsive-text-group" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -0.16061308979988098 608.2968139648438 160" width="38" height="9.995120573410386">
<g class="responsive-text-icon">
<!---->
</g>
<g class="responsive-text-label">
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" viewBox="0 -153 733.765625 193" height="160" width="608.3031088082901">
<text vector-effect="non-scaling-stroke" style="fill: rgb(0, 197, 255); stroke-width: 2; font-size: 160px; line-height: normal;">+209,052</text>
</svg>
</g>
</svg></div>
<!----> </div>
</div>
<!---->
<!----></div>
</full-container>
</margin-container>
</div>
数据由API检索,所以如果你只想要值,你可以尝试直接调用API并排除IE(通常很慢)的需要:
Sub Test()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
With xmlhttp
.Open "GET", "https://services7.arcgis.com/mOBPykOjAyBO2ZKk/arcgis/rest/services/rki_key_data_blbrdv/FeatureServer/0/query?f=json&where=AnzFallNeu%3C%3E0&returnGeometry=false&spatialRel=esriSpatialRelIntersects&outFields=*&orderByFields=AdmUnitId%20asc&resultOffset=0&resultRecordCount=1&resultType=standard&cacheHint=true", False
.Send
Dim regex As Object
Set regex = CreateObject("VbScript.Regexp")
regex.Pattern = """AnzFallNeu"":([\d]{1,}),"
If regex.Test(.responseText) Then
Debug.Print regex.Execute(.responseText)(0).submatches(0)
End If
Set regex = Nothing
End With
Set xmlhttp = Nothing
End Sub
responseText
是一个JSON所以如果你确实需要拉其他数据,你可以考虑使用VBA-JSON而不是Regex
(如图上面的例子)来处理 JSON.