WebBrowserで表のデータ収集 (ID:108555)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ふぅむ……開発環境で動くという事は、取得のタイミングなのでしょうかね。

とりあえず当方で、下記のコードをコンパイルして実行してみましたが、
今の所、エラーは発生していないようです。

Option Explicit

Private Sub Form_Load()
    WebBrowser1.Navigate "http://www.e-typing.ne.jp/index.asp?mode=levelcheck&state=rank"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Dim objElement As Object
    Dim objRow     As Object
    Dim objCells   As Object
    
    Set objElement = WebBrowser1.Document.getElementsByName("1")(0)
    If objElement Is Nothing Then
        Exit Sub
    End If
    Do Until objElement.tagName = "TABLE"
        Set objElement = objElement.parentNode
    Loop
    
    Text1.Text = ""
    Text1.Visible = False
    For Each objRow In objElement.rows
        On Error Resume Next
        With objRow.cells
            AppendText .item(0).innerText
            AppendText vbTab
            AppendText .item(2).innerText
            AppendText vbTab
            AppendText .item(1).innerText
            AppendText vbNewLine
        End With
        On Error GoTo 0
    Next
    Text1.SelStart = 0
    Text1.Visible = True

Set objElement = Nothing
End Sub

Private Sub AppendText(ByVal NewString As String)
    Text1.SelStart = Len(Text1.Text)
    Text1.SelText = NewString
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る