Yahooの検索件数をVBAで抽出したい 削除
Message#2 2014年10月8日(水)20時26分 From: 管理人 |
Yahoo検索のHTMLソースを見ると検索数の部分は以下のようになっています。 <p class="resultNum">約<span class="bo">629,000</span>件</p> pタグで括られているのが分かりますね。こちらのclassで設定されている「resultNum」を見ると他では利用されていない一意のキーワードでしたのでこちらを分岐処理の対象としてみました。 以下がVBAで抽出するプログラムになりますので、ご確認ください。 Sub sample() Dim objIE As InternetExplorer Dim objTag As Object 'YahooをIEで開く Call ieView(objIE, "http://www.yahoo.co.jp/") '「VBA IE」で検索 Call formText(objIE, "p", "VBA IE") Call tagClick(objIE, "input", "検索") Debug.Print tagValue(objIE, "p", "resultNum", "innerText") End Sub Sub ieView(objIE As InternetExplorer, _ urlName As String, _ Optional viewFlg As Boolean = True, _ Optional ieTop As Integer = 0, _ Optional ieLeft As Integer = 0, _ Optional ieWidth As Integer = 1200, _ Optional ieHeight As Integer = 1000) Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = viewFlg objIE.Top = ieTop objIE.Left = ieLeft objIE.Width = ieWidth objIE.Height = ieHeight objIE.navigate urlName Call ieCheck(objIE) End Sub Sub ieCheck(objIE As InternetExplorer) Dim timeout As Date timeout = Now + TimeSerial(0, 0, 10) Do While objIE.Busy = True Or objIE.readyState <> 4 DoEvents Sleep 100 If Now > timeout Then objIE.Refresh timeout = Now + TimeSerial(0, 0, 10) End If Loop timeout = Now + TimeSerial(0, 0, 10) Do Until objIE.document.readyState = "complete" DoEvents Sleep 100 If Now > timeout Then objIE.Refresh timeout = Now + TimeSerial(0, 0, 10) End If Loop End Sub Sub formText(objIE As InternetExplorer, idName As String, tagValue As String) For Each objTag In objIE.document.getElementsByTagName("input") If objTag.Name = idName Then objTag.Value = tagValue Exit For End If Next For Each objTag In objIE.document.getElementsByTagName("textarea") If objTag.Name = idName Then objTag.Value = tagValue Exit For End If Next End Sub Sub tagClick(objIE As InternetExplorer, tag As String, tagStr As String) For Each objTag In objIE.document.getElementsByTagName(tag) If InStr(objTag.outerHTML, tagStr) > 0 Then objTag.Click Call ieCheck(objIE) Exit For End If Next End Sub Function tagValue(objIE As InternetExplorer, _ tagName As String, _ tagStr As String, _ valueType As String) As String For Each objTag In objIE.document.getElementsByTagName(tagName) With objTag If InStr(.outerHTML, tagStr) > 0 Then Select Case valueType Case "innerHTML" tagValue = .innerHTML Case "innerText" tagValue = .innerText Case "outerHTML" tagValue = .outerHTML Case "outerText" tagValue = .outerText End Select Exit For End If End With Next End Function |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。