Search code examples
htmlvbaapiweb-scrapingarcgis

Web Scrapping using VBA

I want to extract data from below website using VBA. Can someone help me with code?

https://experience.arcgis.com/experience/478220a4c454480e823b17327b2bf1d4/page/Bundesl%C3%A4nder/

I have below code but nothing has been returned in eColl object

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 snipplet is as below:

<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>
Solution

  • The data is retrieved by API so if you only wants the value, you can try calling the API directly and exclude the need of IE (which is usually slow):

    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

    The responseText is a JSON so if you do need to pull other data, you can consider using VBA-JSON instead of using Regex (as shown in the example above) to process the JSON.