Excel VBAでInternet Explorerを操作してみよう！（後編）

こんにちは、トマトニックです。Excel VBAを使ってInternet Explorerを操作するというコラムの最終回です。

Excelに記載した検索ワードをもとに「Internet Explorer」を操作していきたいと思います。

前編と中編を振り返りたい方は、以下のリンクをご覧ください。
⇒（「前編」はこちら）
⇒（「中編」はこちら）

※本記事は「Internet Explore 11」で動作確認しています

※ソースコードをコピペした際に「”」、「’」、「-」などが全角になる場合があるようです。半角に直してからプログラムを実行してください。

Excel設定

まずはVBAの画面からExcelの画面に戻り、上記のようなレイアウトを作ります。

3行1列目の「1」は1つ目の「検索ワード」（この例だとメトホルミン）を検索という意味です。「2」と記述した場合は2つ目の「検索ワード」（この例だとアレグラ）を検索という意味になります。

（という意味になります……というよりもそのような挙動になるようにコーディングを組みます）

4行1列目の「○」は現在どの「検索ワード」で検索しているかの目印としています。

コーディング

ではVBAでExcelの検索ワードを読み取りPmdaで検索……の前に、まずは操作の利便性を考えて「Internet Explorer」と「Excel」の表示が横並びになるように設定したいと思います。

'接続先URL
Public Const url As String = "http://www.pmda.go.jp/PmdaSearch/iyakuSearch/"

'Excelウィンドウ設定
Public Const appTop As Integer = 0
Public Const appLeft As Integer = 750
Public Const appWidth As Integer = 690
Public Const appHeight As Integer = 790

'IEウィンドウ設定
Public Const ieTop As Integer = 0
Public Const ieLeft As Integer = 0
Public Const ieWidth As Integer = 995
Public Const ieHeight As Integer = 1050

Sub excelSetting()

'初期設定
Application.WindowState = xlNormal
'Excel Y座標
Application.top = appTop
'Excel X座標
Application.left = appLeft
'Excel 横幅
Application.Width = appWidth
'Excel 縦幅
Application.Height = appHeight

'Excelを前面に表示
AppActivate "Microsoft Excel", False

End Sub

Sub ieSetting(objIE As InternetExplorer)

'IE Y座標
objIE.top = ieTop
'IE X座標
objIE.left = ieLeft
'IE 横幅
objIE.Width = ieWidth
'IE 縦幅
objIE.Height = ieHeight

End Sub

Sub main()

Dim objIE As InternetExplorer

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IEを表示する
objIE.Visible = True

'Excelのウィンドウ設定
Call excelSetting
'IEのウィンドウ設定
Call ieSetting(objIE)

'Pmdaの検索ページを表示する
objIE.navigate url

'IEの表示を待つ
Call ieWait(objIE)

'くすりの名称のテキストボックスにフォーカスをあてる
objIE.document.getElementsByName("nameWord")(0).Focus
Call ieWait(objIE)

'テキストボックスに検索ワードを入力
objIE.document.getElementsByName("nameWord")(0).Value = "メトホルミン"
Call ieWait(objIE)

'検索ボタンをクリック
objIE.document.getElementsByName("btnA")(0).Click
Call ieWait(objIE)

End Sub

 

これで「Internet Explorer」と「Excel」の表示が横並びになりました。ただ、これはディスプレイのサイズにもよりますので下記部分を各々設定する必要があります。

（Topはディスプレイの上端からの距離、Leftはディスプレイの左端からの距離、Widthは横幅、Heightは縦幅の設定です）

ちなみに「Public Const」は定数という意味で、「y = ax + b」における「a」や「b」などの初期値を設定する際に記述します。

'Excelウィンドウ設定
Public Const appTop As Integer = 0
Public Const appLeft As Integer = 750
Public Const appWidth As Integer = 690
Public Const appHeight As Integer = 790

'IEウィンドウ設定
Public Const ieTop As Integer = 0
Public Const ieLeft As Integer = 0
Public Const ieWidth As Integer = 995
Public Const ieHeight As Integer = 1050

何度もプログラムを動かすことになりますので下記部分を「'」でコメントアウトしましょう。

'objIE.document.getElementsByName("btnA")(0).Click

セルの座標

Excelのあるセルからデータを取得する、またはデータを入力する場合、セルの座標を指定する必要があります。下記のソースでは「MsgBox」でダイアログを表示、「Cells(4, 2).Value」で４行目２列目の値を取得しています。このコードを実行すると「メトホルミン」がダイアログで表示されます。

Sub test()

MsgBox Cells(4, 2).Value

End Sub

 

座標のイメージ

コーディング

どのセルから検索ワードを取得するかというコーディングを行います。Excelを確認しながらコーディングしてください。初期座標として検索ワード位置(B3セル)の座標を3行2列目、検索対象位置(A3セル)の座標を3行1列目として設定します。

'検索ワード位置(B3セル)
Public Const row0 As Integer = 3
Public Const col0 As Integer = 2

'検索対象位置(A3セル)
Public Const rowIndex As Integer = 3
Public Const colIndex As Integer = 1

Dim pRow As Integer

Function getIndex()

getIndex = Cells(rowIndex, colIndex).Value + rowIndex

End Function

 

これをさきほどのウィンドウ設定の下に追記します。さらに取得した検索ワードをPmdaのテキストボックスに入力するためにソースを変更します。

Sub main()

Dim objIE As InternetExplorer
Dim searchWord As String

'検索位置取得
pRow = getIndex()
'検索ワード取得
searchWord = Cells(pRow, col0).Value

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IEを表示する
objIE.Visible = True

'Excelのウィンドウ設定
Call excelSetting
'IEのウィンドウ設定
Call ieSetting(objIE)

'Pmdaの検索ページを表示する
objIE.navigate url

'IEの表示を待つ
Call ieWait(objIE)

'くすりの名称のテキストボックスにフォーカスをあてる
objIE.document.getElementsByName("nameWord")(0).Focus
Call ieWait(objIE)

'テキストボックスに検索ワードを入力
objIE.document.getElementsByName("nameWord")(0).Value = searchWord
Call ieWait(objIE)

'検索ボタンをクリック
objIE.document.getElementsByName("btnA")(0).Click
Call ieWait(objIE)

End Sub

A3セルに「1」と入力しているのでgetIndex()で「4」が返却され「pRow」の値は「4」となります。また、「col0」は「2」と設定しているのでデフォルトで「Cells(pRow, col0).Value」はB4セル（4行目2列目）の値「メトホルミン」が取得され「searchWord」に設定されます。

この「searchWord」の値をExcelの検索ワードと連動させることで「Pmda」のサイトに任意の検索ワードで検索できるようにコーディングをしていきます。

ボタンの作成

検索をVBAからではなくExcel上で行いたいのでボタンを配置します。開発タブから挿入でボタンを選択します。その際、どのマクロを設定するか聞かれますがこのタイミングでは特に設定しません。

 

このように「<」、「検索」、「>」の3つのボタンを配置します。この状態で「検索」ボタンをクリックすると「メトホルミン」が検索され、「>」ボタンをクリックするとメトホルミンの次の「アレグラ」が検索され、「<」ボタンをクリックするとアレグラの前の「メトホルミン」が検索されるという作り込みをしたいと思います。

コーディング

Sub search()

'検索位置取得
pRow = getIndex()
Cells(pRow, col0 - 1).Value = "○"

Call main

End Sub

Sub prevSearch()

'検索位置取得
pRow = getIndex()

'行制限チェック
If (pRow - 1 > rowIndex) Then

Cells(pRow, col0 - 1).Value = ""

pRow = pRow - 1
Cells(pRow, col0 - 1).Value = "○"

'検索位置書き換え
Cells(rowIndex, colIndex).Value = pRow - row0

Call main

End If

End Sub

Sub nextSearch()

'検索位置取得
pRow = getIndex()
Cells(pRow, col0 - 1).Value = ""

pRow = pRow + 1
Cells(pRow, col0 - 1).Value = "○"

'検索位置書き換え
Cells(rowIndex, colIndex).Value = pRow - row0

Call main

End Sub

「検索」が「search()」、「<」が「prevSearch()」、「>」が「nextSearch()」のメソッドにそれぞれ対応します。これらの挙動をボタンのマクロとして割り当てます。

「Sub search()」では単純に「Sub main()」のコードを呼び出して実行しています。その際に検索ワードの左の列に現在どの検索ワードで検索しているかの目印「○」をセットしています。

「Sub prevSearch()」では現在の検索ワードの一つ上の検索ワードを検索します。そのためにA3の値を「-1」する必要があり、「pRow = getIndex()」でA3の値を取得し「pRow = pRow - 1」としますが、

メトホルミンより上は検索できませんので「If (pRow - 1 > rowIndex) Then」で行制限を掛けています。行制限を掛けた上で一つ上の検索をする場合はA3の値を「-1」および目印「○」を書き換えた上で「Sub main()」のコードを呼び出して実行しています。

「Sub nextSearch()」は「Sub prevSearch()」の逆で一つ下の検索ワードを検索します。A3の値を「+1」および目印「○」を書き換えた上で「Sub main()」のコードを呼び出して実行しています。

 

これで各ボタンにマクロの割り当てが完了しました。では早速挙動を確認しましょう。

 

挙動確認

「検索ボタン」をクリックします。※ここでうまく動かない場合はページの最後にソースコードをまとめていますので適宜参照してください。

無事「メトホルミン」で検索できました。次に「>」ボタンをクリックします。

今度は「アレグラ」で検索できました。最後に「<」ボタンをクリックします。

一つ手前の「メトホルミン」で再び検索できました。これで挙動確認は無事完了です。

まとめ

「VBA」で「Internet Explorer」を操作することでExcelの検索ワードを「Pmda」に自動入力して検索することができました。この技術を応用すれば色々な作業を省力化できます。

今回紹介した方法を応用すればユーザー、パスワードを入力して自動ログインなどもできますので皆さんも色々試してみてください。前編、中編、後編と長い間お付き合い頂きありがとうございました！

※これまでに出てきたソースコードを以下にまとめましたので参考にして頂ければと思います。

 

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'接続先URL
Public Const url As String = "http://www.pmda.go.jp/PmdaSearch/iyakuSearch/"

'Excelウィンドウ設定
Public Const appTop As Integer = 0
Public Const appLeft As Integer = 750
Public Const appWidth As Integer = 690
Public Const appHeight As Integer = 790

'IEウィンドウ設定
Public Const ieTop As Integer = 0
Public Const ieLeft As Integer = 0
Public Const ieWidth As Integer = 995
Public Const ieHeight As Integer = 1050

'検索ワード位置(B3セル)
Public Const row0 As Integer = 3
Public Const col0 As Integer = 2

'検索対象位置(A3セル)
Public Const rowIndex As Integer = 3
Public Const colIndex As Integer = 1

Dim pRow As Integer

Function getIndex()

getIndex = Cells(rowIndex, colIndex).Value + rowIndex

End Function

Sub excelSetting()

'初期設定
Application.WindowState = xlNormal
'Excel Y座標
Application.top = appTop
'Excel X座標
Application.left = appLeft
'Excel 横幅
Application.Width = appWidth
'Excel 縦幅
Application.Height = appHeight
'Excelを前面に表示
AppActivate "Microsoft Excel", False

End Sub

Sub ieSetting(objIE As InternetExplorer)

'IE Y座標
objIE.top = ieTop
'IE X座標
objIE.left = ieLeft
'IE 横幅
objIE.Width = ieWidth
'IE 縦幅
objIE.Height = ieHeight

End Sub

Sub search()

'検索位置取得
pRow = getIndex()
Cells(pRow, col0 - 1).Value = "○"

Call main

End Sub

Sub prevSearch()

'検索位置取得
pRow = getIndex()

'行制限チェック
If (pRow - 1 > rowIndex) Then

Cells(pRow, col0 - 1).Value = ""

pRow = pRow - 1
Cells(pRow, col0 - 1).Value = "○"

'検索位置書き換え
Cells(rowIndex, colIndex).Value = pRow - row0

Call main

End If

End Sub

Sub nextSearch()

'検索位置取得
pRow = getIndex()
Cells(pRow, col0 - 1).Value = ""

pRow = pRow + 1
Cells(pRow, col0 - 1).Value = "○"

'検索位置書き換え
Cells(rowIndex, colIndex).Value = pRow - row0

Call main

End Sub

Sub main()

Dim objIE As InternetExplorer
Dim searchWord As String

'検索位置取得
pRow = getIndex()
'検索ワード取得
searchWord = Cells(pRow, col0).Value

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IEを表示する
objIE.Visible = True

'Excelのウィンドウ設定
Call excelSetting
'IEのウィンドウ設定
Call ieSetting(objIE)

'Pmdaの検索ページを表示する
objIE.navigate url

'IEの表示を待つ
Call ieWait(objIE)

'くすりの名称のテキストボックスにフォーカスをあてる
objIE.document.getElementsByName("nameWord")(0).Focus
Call ieWait(objIE)

'テキストボックスに検索ワードを入力
objIE.document.getElementsByName("nameWord")(0).Value = searchWord
Call ieWait(objIE)

'検索ボタンをクリック
objIE.document.getElementsByName("btnA")(0).Click
Call ieWait(objIE)

End Sub

Sub ieWait(objIE As InternetExplorer)

Do While objIE.Busy = True Or objIE.readyState <> 4

Sleep 100
DoEvents

Loop

End Sub

 

 

※上記のソースコードにはInternet Explorerがいくつも開いてしまう問題点があります。改良版を下記に置きます。

Pmda検索