14

VBS/VBA を使用して Web ページからデータをスクレイピングして遊んでいます。

Javascript の場合は簡単なので離れてしまいますが、VBS/VBA ではそれほど簡単ではないようです。

これは私が回答のために作成した例です。動作しますが、使用して子ノードにアクセスすることを計画していましたが、getElementByTagNameそれらの使用方法がわかりませんでした! オブジェクトにはこれらのHTMLElementメソッドがありません。

Sub Scrape()
Dim Browser As InternetExplorer
Dim Document As HTMLDocument
Dim Elements As IHTMLElementCollection
Dim Element As IHTMLElement

Set Browser = New InternetExplorer

Browser.navigate "http://www.hsbc.com/about-hsbc/leadership"

Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
    DoEvents
Loop

Set Document = Browser.Document

Set Elements = Document.getElementsByClassName("profile-col1")

For Each Element in Elements
    Debug.Print "[  name] " & Trim(Element.Children(1).Children(0).innerText)
    Debug.Print "[ title] " & Trim(Element.Children(1).Children(1).innerText)
Next Element

Set Document = Nothing
Set Browser = Nothing
End Sub

私はHTMLElement.documentプロパティを見て、それがドキュメントの断片のようであるかどうかを確認しましたが、操作が難しいか、単に私が思うものではありません

Dim Fragment As HTMLDocument
Set Element = Document.getElementById("example") ' This works
Set Fragment = Element.document ' This doesn't

これはまた、それを行うための長い道のりのようです (ただし、通常は vba imo の方法です)。関数をチェーンする簡単な方法があるかどうかは誰にも分かりますか?

Document.getElementById("target").getElementsByTagName("tr")素晴らしいだろう...

4

4 に答える 4

13 
Sub Scrape()
    Dim Browser As InternetExplorer
    Dim Document As htmlDocument
    Dim Elements As IHTMLElementCollection
    Dim Element As IHTMLElement

    Set Browser = New InternetExplorer
    Browser.Visible = True
    Browser.navigate "http://www.stackoverflow.com"

    Do While Browser.Busy And Not Browser.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop

    Set Document = Browser.Document

    Set Elements = Document.getElementById("hmenus").getElementsByTagName("li")
    For Each Element In Elements
        Debug.Print Element.innerText
        'Questions
        'Tags
        'Users
        'Badges
        'Unanswered
        'Ask Question
    Next Element

    Set Document = Nothing
    Set Browser = Nothing
End Sub
于 2013-03-04T00:44:13.873 に答える
5

私も好きじゃない。

したがって、javascript を使用します。

Public Function GetJavaScriptResult(doc as HTMLDocument, jsString As String) As String

    Dim el As IHTMLElement
    Dim nd As HTMLDOMTextNode

    Set el = doc.createElement("INPUT")
    Do
        el.ID = GenerateRandomAlphaString(100)
    Loop Until Document.getElementById(el.ID) Is Nothing
    el.Style.display = "none"
    Set nd = Document.appendChild(el)

    doc.parentWindow.ExecScript "document.getElementById('" & el.ID & "').value = " & jsString

    GetJavaScriptResult = Document.getElementById(el.ID).Value

    Document.removeChild nd

End Function


Function GenerateRandomAlphaString(Length As Long) As String

    Dim i As Long
    Dim Result As String

    Randomize Timer

    For i = 1 To Length
        Result = Result & Chr(Int(Rnd(Timer) * 26 + 65 + Round(Rnd(Timer)) * 32))
    Next i

    GenerateRandomAlphaString = Result

End Function

これに問題がある場合はお知らせください。コンテキストをメソッドから関数に変更しました。

ところで、IEのバージョンは何をお使いですか？< IE8 を使用していると思われます。IE8 にアップグレードすると、shdocvw.dll が ieframe.dll に更新され、document.querySelector/All を使用できるようになると思います。

編集

実際にはコメントではないコメント応答: 基本的に、VBA でこれを行う方法は、子ノードをトラバースすることです。問題は、正しい戻り値の型を取得できないことです。IHTMLElement と IHTMLElementCollection を (個別に) 実装する独自のクラスを作成することで、これを修正できます。しかし、それは私が支払いを受けずにそれを行うにはあまりにも苦痛です:)。決定した場合は、VB6/VBA の Implements キーワードを読んでください。

Public Function getSubElementsByTagName(el As IHTMLElement, tagname As String) As Collection

    Dim descendants As New Collection
    Dim results As New Collection
    Dim i As Long

    getDescendants el, descendants

    For i = 1 To descendants.Count
        If descendants(i).tagname = tagname Then
            results.Add descendants(i)
        End If
    Next i

    getSubElementsByTagName = results

End Function

Public Function getDescendants(nd As IHTMLElement, ByRef descendants As Collection)
    Dim i As Long
    descendants.Add nd
    For i = 1 To nd.Children.Length
        getDescendants nd.Children.Item(i), descendants
    Next i
End Function
于 2013-03-03T23:40:32.910 に答える