ExcelのVBAでInternet Explorerを操作する　その2

前回に続いてInternet ExplorerをExcelのVBAから操作する術をまとめます。

前回はIEを起動して指定したURLの表示を完了させるところまで行きましたので、今回はそこから特定の文字列やタグを抜き出す方法を見てみます。

Excelであれば結果をダイレクトに表として残せるので、使い道は色々ありそうな気がしますしね～

まずは前回開いたページを検索していくために、ハイパーリンクを探して格納するプロシージャを追加していきます。

dim a as object

dim urls as New Collection

For Each a in ie.document getelementsByTagName("A")

urls.Add a.href

Next

これで開いたIEのHTML文書からAタグを全て探し出してurlsに格納するという動作を行います。

Dim url As Variant
Dim i As Long
i = 1
For Each url In urls
ie.Navigate url
waitNavigation ie
ActiveSheet.Cells(i, 1).Value = i
ActiveSheet.Cells(i, 2).Value = ie.document.Title
ActiveSheet.Cells(i, 3).Value = ie.locationurl

If InStr(ie.document.body.innerHTML, "AiMidorita.png") > 0 Then
ActiveSheet.Cells(i, 4).Value = "○"
Else
ActiveSheet.Cells(i, 4).Value = "-"
End If
i = i + 1
Next

MsgBox "終了しました。"

以上のプログラムを続きに書き込んで動かしてみると・・・

ざっと説明するとHTML文書から抜き出して格納したURLを順に見ていき、そのURLと探したいファイル（ここでは"AiMidorita.png"）を発見したら○を、なければ×をセルに書き込んでいきます。

最後に最初から最後まで纏めて記述しておくと・・・

Sub Main()
    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True

    ie.Navigate "http://www.forest.impress.co.jp/article/2013/05/excelvba/"
    waitNavigation ie

    'すべてのハイパーリンクのURLを取得
    Dim a As Object
    Dim urls As New Collection
    For Each a In ie.Document.getElementsByTagName("A")
        urls.Add a.href
    Next

    'すべてのページをチェック
    Dim url As Variant
    Dim i As Long
    i = 1
    For Each url In urls
        'Webページを移動
        ie.Navigate url
        waitNavigation ie
        '場所を書き出し
        ActiveSheet.Cells(i, 1).Value = i
        ActiveSheet.Cells(i, 2).Value = ie.Document.Title
        ActiveSheet.Cells(i, 3).Value = ie.LocationURL
        '翠田あいの存在をチェック
        If InStr(ie.Document.body.innerHTML, "AiMidorita.png") > 0 Then
            ActiveSheet.Cells(i, 4).Value = "○"
        Else
            ActiveSheet.Cells(i, 4).Value = "－"
        End If
        i = i + 1
    Next
End Sub

'画面移動の完了待ち
Sub waitNavigation(ie As Object)
    Do While ie.Busy Or ie.ReadyState < 4
        DoEvents
    Loop
End Sub

といった感じでしょうか。

興味があったら是非お試しください。