VBAでWEB検索（IE操作）

概要

　エクセルVBAから、ＩＥ（インターネットエクスプローラー）を使って、ホームページを開き、データ検索などの操作する時のメモです。

成果物

（１）書籍検索

　下の図は、エクセルシートの黄色部分にキーワードを入力し、検索ボタンをクリックすると実際に市販されている書籍を検索し、タイトルと価格を表に出力するものです。
　具体的名称等は省略しますが、実際にある某書店の検索ページを開き、キーワード入力・検索ボタンをクリックして得られる結果から、データを取得しています。

（２）英単語検索

　次の図は、エクセルシートの最左列に複数の英単語を入力し、検索ボタンをクリックすると(1)同様にインターネットエクスプローラーで検索サイトを開き、意味を取得し表示するものです。

参照設定

　先ず準備として、参照設定を追加します。
　① Microsoft HTML Object Library
　② Microsoft Internet Controls

プログラム

　検索はホームページのタグ名、クラス名等を利用して情報を取得しています。予めブラウザーの検証機能等を利用し、ＨＴＭＬ上にデータが記載されている場所とデータ取得方法などを確認しておく必要があります。

（１）書籍検索

'シート側コマンドボタン
Private Sub CommandButton1_Click()
    Call ie_search_book_info
End Sub


'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
Option Explicit 
#If Win64 Then 
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
#End If

Public Sub ie_search_book_info()
    Dim objIE As InternetExplorer
    Dim objtag As Object
    Dim objTmp As Object
    
    Dim timeOut As Date
    Dim tmp, sht
    Dim book_name
    Dim book_info
    Dim bookPrice
    Dim cnt

    sht = ActiveSheet.Name
    Worksheets(sht).Range("A5:B200").ClearContents
    book_name = Trim(Worksheets(sht).Cells(2, 1).Value)
    

On Error GoTo errHandler

    Set objIE = CreateObject("InternetExplorer.Application")        ' IEｵﾌﾞｼﾞｪｸﾄ作成
    objIE.Visible = True                                            ' IE起動
    objIE.navigate "<省略：検索サイトＵＲＬ>"

    ' 完全に表示されるまで待機
    timeOut = Now + TimeSerial(0, 0, 20)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        Sleep 1
        
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
    
    ' 書籍名を設定
    For Each objtag In objIE.document.getElementsByTagName("input")
        If objtag.getAttribute("class") = "[省略：クラス名]" Then
             objtag.innerText = book_name
             Exit For
        End If
    Next
    
    ' 検索ボタンをクリック
    For Each objtag In objIE.document.getElementsByTagName("input")
        If objtag.getAttribute("class") = "[省略：クラス名]" Then
             objtag.Click
             Exit For
        End If
    Next

    Sleep (200)
    
    ' 完全に表示されるまで待機
    timeOut = Now + TimeSerial(0, 0, 20)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        Sleep 1
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
    
    Sleep (500)
    
    ' 検索結果から、書籍名・価格を取得
    cnt = 0
    For Each objtag In objIE.document.getElementsByTagName("div")
        tmp = objtag.getAttribute("class")
    
        If InStr(tmp, "[省略：クラス名]") > 0 Then
             
            book_info = objtag.getElementsByTagName("h3")(0).innerText
            bookPrice = ""
            
            For Each objTmp In objtag.getElementsByTagName("span")
                If objTmp.getAttribute("class") = "[省略：クラス名]" Then
                    bookPrice = objTmp.innerText
                End If
            Next
             
            Worksheets(sht).Cells(5 + cnt, 1).Value = book_info
            Worksheets(sht).Cells(5 + cnt, 2).Value = bookPrice
             
            cnt = cnt + 1
        
        End If
    Next

   
    
    objIE.Quit                                                      ' IEを閉じる
    Set objIE = Nothing

    Exit Sub
    
' ｴﾗｰ処理
errHandler:
    objIE.Quit
    Set objIE = Nothing
    
    On Error GoTo 0
    
End Sub

（２）英単語検索

'シート側コマンドボタン
Private Sub CommandButton1_Click()
    Dim sht, wrd
    Dim cnt
    Dim ret
    
    sht = ActiveSheet.Name
    cnt = 0
    
    Do
        wrd = Trim(Worksheets(sht).Cells(5 + cnt, 1).Value)
        If wrd = "" Then Exit Do
        
        wrd = StrConv(StrConv(wrd, 8), 2)
        ret = ie_search_e_word(wrd)

        Worksheets(sht).Cells(5 + cnt, 2).Value = ret
        DoEvents
        cnt = cnt + 1
    Loop
End Sub

'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
Option Explicit

#If Win64 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    '// 指定URLファイルのダウンロード
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
        ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    '// キャッシュクリア
    Public Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    '// 指定URLファイルのダウンロード
    Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
        ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    '// キャッシュクリア
    Public Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#End If


' 単語検索
Public Function ie_search_e_word(s_word)
    Dim objIE As InternetExplorer
    Dim objtag As Object
    Dim timeOut As Date
    Dim tmp
    Dim ret
    Dim cntnt(2)
    
On Error GoTo errHandler
    ie_search_e_word = ""
    
    Set objIE = CreateObject("InternetExplorer.Application")        ' IEｵﾌﾞｼﾞｪｸﾄ作成
    objIE.Visible = True                                            ' IE起動
    objIE.navigate "<省略：検索サイトＵＲＬ>" + s_word       ' 単語を検索する

    ' 完全に表示されるまで待機
    timeOut = Now + TimeSerial(0, 0, 20)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        Sleep 1
        
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
    
    ' 主な意味取得
    For Each objtag In objIE.document.getElementsByTagName("td")
        tmp = objtag.outerHTML
        If InStr(tmp, "[省略：クラス名]") > 0 Then
            cntnt(0) = objtag.innerText
            Exit For
        End If
    Next
    
    ie_search_e_word = cntnt(0)
    
    ' 音声ファイル取得
    For Each objtag In objIE.document.getElementsByTagName("[省略]")(0).getElementsByTagName("[省略]")
        cntnt(1) = objtag.getAttribute("[省略]")                       ' URL取得
        Exit For
    Next
    

    
    ' 音声ファイルをダウンロード
    ret = -1
    If cntnt(1) <> "" Then
        If Right(cntnt(1), 4) = ".mp3" Then
            cntnt(2) = "[省略]" + s_word + Right(cntnt(1), 4)
            Call DeleteUrlCacheEntry(cntnt(1))                          ' キャッシュクリア
            ret = URLDownloadToFile(0, cntnt(1), cntnt(2), 0, 0)        ' ダウンロード
        End If
    End If
    
    objIE.Quit                                                      ' IEを閉じる
    Set objIE = Nothing

    Exit Function
    
' ｴﾗｰ処理
errHandler:
    objIE.Quit
    Set objIE = Nothing
    
    On Error GoTo 0
    
End Function

クリック処理

　（１）書籍検索のプログラム行番５９の様にブラウザ内ボタンをクリックし処理を進めることがあります。今回の場合は特に問題はありませんが、最終確認や入力内容チェック結果などをメッセージボックスで表示することがあります。その場合、❛OK❜ボタンをクリックするなどして、メッセージボックスを消すまでVBAプログラムは先に進みません。
　次の行番１３の様に javascript でクリックをすることでVBAプログラムは停止しません。次にメッセージボックスのウィンドウハンドルを取得し、SendMessage でクリック相当処理を行い、メッセージボックスを消すことが出来ます。

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _  
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _  
    (ByVal hwnd As Long, ByVal msg As Long, _  
     ByVal wParam As Long, ByVal lParam As Long) As Long  
 
Const WM_COMMAND = &H111

'********************************************************************

Dim hwnd As Long

objIE.Document.Script.setTimeout "javascript:document.getElementByName('[省略]')(0).click()", 200

hwnd = FindWindow("#32770", "Web　ページからのメッセージ")

While hwnd = 0
   DoEvents
   Sleep 1
   hwnd = FindWindow("#32770", "Web　ページからのメッセージ")
Wend
SendMessage hwnd , WM_COMMAND, vbOK, ByVal 0&

まとめ

　息子が中高生の時に勉強を手伝って、英単語を調べたりしていました。その時、この方法を知っていれば、もっと楽に調査できたと思います。
　でも、きっとまた使えることもあるでしょう。

月	火	水	木	金	土	日
	1	2	3	4	5	6
7	8	9	10	11	12	13
14	15	16	17	18	19	20
21	22	23	24	25	26	27
28	29	30

KatsEye

VBAでWEB検索（IE操作）

概要

成果物

参照設定

プログラム

クリック処理

まとめ

コメントを残すコメントをキャンセル

IoT な日常の探求

概要

成果物

参照設定

プログラム

クリック処理

まとめ

コメントを残す コメントをキャンセル

IoT な日常の探求

コメントを残すコメントをキャンセル