Sub Main()
    'IEを開く
    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