bugfix> regex > 投稿

Excel VBAを使用して、これからいくつかのデータをスクレイピングする必要がありますウェブサイト。

関連するウェブサイトオブジェクトには id が含まれていないため 、 HTML.Document.GetElementById を使用できません 。

ただし、関連情報は常に <div> に保存されることに気付きました -次のようなセクション:

<div style="padding:7px 12px">Basler Versicherung AG &#214;zmen</div>

質問: RegExp を構築することは可能ですかおそらくループで、 <div style="padding:7px 12px"> 内のコンテンツを返すそして次の </div>

私がこれまでに持っているのは完全な InnerHtml ですコンテナの、まだ構築されていないRegExpをループするコードを追加する必要があることは明らかです。

Private Function GetInnerHTML(url As String) As String
    Dim i As Long
    Dim Doc As Object
    Dim objElement As Object
    Dim objCollection As Object
On Error GoTo catch
   'Internet Explorer Object is already assigned
   With ie
        .Navigate url
        While .Busy
        GetInnerHTML = .document.getelementbyId("cphContent_sectionCoreProperties").innerHTML
    End With
    Exit Function
    GetInnerHTML = Err.Number & " " & Err.Description
End Function

回答 2 件
  • XMLHTTP を使用して同じことを達成できる別の方法  リクエストメソッド。試してごらん:

    Sub Fetch_Data()
        Dim S$, I&
        With New XMLHTTP60
            .Open "GET", "https://www.uid.admin.ch/Detail.aspx?uid_id=CHE-105.805.649", False
            S = .responseText
        End With
        With New HTMLDocument
            .body.innerHTML = S
            With .querySelectorAll("#cphContent_sectionCoreProperties label[id^='cphContent_ct']")
                For I = 0 To .Length - 1
                    Cells(I + 1, 1) = .Item(I).innerText
                    Cells(I + 1, 2) = .Item(I).NextSibling.FirstChild.innerText
                Next I
            End With
        End With
    End Sub


    Microsoft HTML Object Library
    Microsoft XML, V6.0

  • ページ上のコンテンツを見つけるために正規表現は必要ないと思います。要素の相対位置を使用してコンテンツを見つけることができます私は信じている あなたは後です。


    Option Explicit
    Public Sub GetContent()
        Dim URL     As String: URL = "https://www.uid.admin.ch/Detail.aspx?uid_id=CHE-105.805.649"
        Dim IE      As Object: Set IE = CreateObject("InternetExplorer.Application")
        Dim Labels  As Object
        Dim Label   As Variant
        Dim Values  As Variant: ReDim Values(0 To 1, 0 To 5000)
        Dim i       As Long
        With IE
            .Navigate URL
            .Visible = False
            'Load the page
            Do Until IE.busy = False And IE.readystate = 4
            'Find all labels in the table
            Set Labels = IE.document.getElementByID("cphContent_pnlDetails").getElementsByTagName("label")
            'Iterate the labels, then find the divs relative to these
            For Each Label In Labels
                Values(0, i) = Label.InnerText
                Values(1, i) = Label.NextSibling.Children(0).InnerText
                i = i + 1
        End With
        'Dump the values to Excel
        ReDim Preserve Values(0 To 1, 0 To i - 1)
        ThisWorkbook.Sheets(1).Range("A1:B" & i) = WorksheetFunction.Transpose(Values)
        'Close IE
    End Sub