Step 6 Yahooの検索結果の総件数を取得

Yahoo・Googleの検索順位チェックソフトを作ってみよう

Step 6　Yahooの検索結果の総件数を取得

前回ヤフーで検索に成功しました、次にグーグルで検索してみます。

実行結果画面

100件検索させた結果から総検索件数を調べます。
検索すると表示される「ウェブ検索結果（検索結果の見方）1～100件目 / 約○○○○○件 - 0.02秒」の約○件の件数です。
検索には、inStr関数を使います。

テストコード

下記のコードを入力してください。

Private Sub ExYahooSearch(shtml As String)
    Dim ln1 As Long
    Dim ln2 As Long
    Dim ln3 As Long
    Dim s1 As String

    '検索件数を調べる
    ln3 = 0
    ln1 = InStr(1, shtml, "件目 / 約<strong>")
    If ln1 > 0 Then
        ln2 = InStr(ln1, shtml, "</strong>")
        s1 = Mid(shtml, ln1 + Len("件目 / 約<strong>"), ln2 - (ln1 + Len("件目 / 約<strong>")))
        ln3 = s1
    End If
End Sub

下記のコードに変更してください。

Private Function ExYahooCheck(skw As String)
    Dim sttime As Long
    Dim passtime As Long
    Dim skwutf As String
    Dim surl As String
    Dim shtml As String

    skwutf = ExEncodeToUTF8(skw)
    '100件検索表示
    surl = "http://search.yahoo.co.jp/search?_adv_prop=web&x=op&ei=UTF-8&fr=op&va="
    surl = surl & skwutf
    surl = surl & "&va_vt=any&vp_vt=any&vo_vt=any&ve_vt=any&vd=all&vst=0&vf=all&yuragi=on&fl=0&n=100&submit=%E6%A4%9C%E7%B4%A2"

    ExYahooCheck = False
On Error GoTo ErrExit
    Set tIEobj = CreateObject("InternetExplorer.application")
    tIEobj.navigate surl
    tIEobj.Visible = True
    '読み込みが終わるまで30秒待つ
    sttime = Timer
    Do
        '経過時間を算出
        passtime = Timer - sttime
        DoEvents
        If passtime >= 30 Then
            Exit Do
        End If
        '読込み完了
        If tIEobj.ReadyState = 4 Then
            Exit Do
        End If
    Loop
    If tIEobj.ReadyState <> 4 Then
        MsgBox "IEをオープンできませんでした。処理を中止します。"
    Else
        If LCase(tIEobj.document.URL) <> LCase(surl) Then
            MsgBox "入力されたURLを開くことができませんでした。URLを確認してください。"
        Else
            shtml = tIEobj.document.body.innerHTML
            ExYahooCheck = True
        End If
    End If

ErrResume:
On Error Resume Next
    tIEobj.Quit
    Set tIEobj = Nothing

    If ExYahooCheck = True Then
        ExYahooSearch shtml
    End If
    Exit Function

ErrExit:
    MsgBox "処理中にエラーが発生しました。処理を中止します。" & vbCrLf & Err.Description
    Resume ErrResume
End Function

Topへ