ウェブの検索結果を自動的にエクセルファイルに反映する方法

質問

エクセルファイルに電話番号リストが入っています。
この電話番号を１つ１つ手作業で、ヤフー電話帳で検索し、
電話帳に掲載されていれば○、掲載が無ければ×を
入力してています。
この作業を自動的に行う方法はありますか？

どんなプログラム、ソフトを用いる方法でもかまいません。
とにかく頭の痛くなる作業から誰か開放してください。

回答No.2

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

VBA と HTML に関する知識があれば、技術的にはそれほど難しくはないです。
Excel VBA ＋ InternetExplorer で実現は可能ですね。

Yahoo！電話帳の検索 URL は下記の通りです。

http://phonebook.yahoo.co.jp/bin/search?p=xxx-xxx-xxxx

xxx-xxx-xxxx の部分に検索対象となる電話番号を渡すだけです。番号にハイ
フンがあってもなくても構いません。

ただし、「掲載あり・なし」の判定ロジックは「不一致キーワード」があるか
ないかという極めて単純なものですから、不十分であればコードを修正して下
さい。

サンプルでは A2 セル以下に電話番号があるものとして、最終行までループし、
掲載があれば B 列に○を書き込みます。

Visual Basic Editor を起動し、以下のソースコードを標準モジュールにコ
ピー＆ペーストして下さい。

'---(標準モジュール）--------------------------------------------------

Option Explicit

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private mIE　As Object ' InternetExplorer

Private Const READYSTATE_COMPLETE = &H4
Private Const OLECMDID_CLOSE = &H2D
Private Const OLECMDEXECOPT_DODEFAULT = &H0

'----------------------------------------------------------------------
' [検索ベースURL]
Private Const QUERY_URL = "http://phonebook.yahoo.co.jp/bin/search?p="
' [不一致キーワード]
Private Const UNMATCH_KEYWORD = "名称との一致：0件"
' [タイムアウト]
Private Const TIMEOUT = 15000　' (単位：ミリ秒）15000ミリ秒 --> 15秒
'----------------------------------------------------------------------
'

' // ExistPhonenum 使い方サンプルプロシージャ
Sub Yahoo電話帳検索()

　　' アクティブシートのA2～A列最終行までに記載された電話番号を
　　' Yahoo!電話帳で検索し、掲載があれば B列に○を書き込む

　　Dim strURL As String
　　Dim i　　　As Long

　　' InternetExplorer を起動して参照する
　　Set mIE = CreateObject("InternetExplorer.Application")
　　' InternetExplorer 可視化
　　mIE.Visible = True

　　With ActiveSheet
　　　　For i = 2 To .Cells(65536, "A").End(xlUp).Row
　　　　　　With .Cells(i, "A")
　　　　　　　　' 検索結果が True なら ○ を B列に記入
　　　　　　　　If ExistPhonenum(CStr(.Value)) Then
　　　　　　　　　　.Offset(0, 1).Value = "○"
　　　　　　　　Else
　　　　　　　　　　.Offset(0, 1).Value = "×"
　　　　　　　　End If
　　　　　　End With
　　　　Next i
　　End With

　　' InternetExplorer を閉じる
　　mIE.ExecWB OLECMDID_CLOSE, OLECMDEXECOPT_DODEFAULT
　　' オブジェクト変数を開放
　　Set mIE = Nothing

End Sub

' // Yahoo!電話帳で引数 strPhoneNumber の電話番号を検索し、掲載があれ
' // ば True を返す
Private Function ExistPhonenum(ByRef strPhoneNumber As String) As Boolean

　　Dim lngT　　As Long
　　Dim blnFlag As Boolean

　　If mIE Is Nothing Then
　　　　Err.Raise 1000, , "InternetExplorer が初期化されておりません"
　　　　Exit Function
　　End If

　　blnFlag = True
　　With mIE
　　　　' 検索 URL の生成
　　　　.Navigate URL:=QUERY_URL & strPhoneNumber
　　　　lngT = timeGetTime() + TIMEOUT
　　　　' ページの読み込みが完了するまで待機
　　　　Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE
　　　　　　DoEvents
　　　　　　' タイムアウト判定
　　　　　　If lngT < timeGetTime() Then
　　　　　　　　blnFlag = False
　　　　　　　　Exit Do
　　　　　　End If
　　　　Loop
　　　　If blnFlag Then
　　　　　　' 検索結果のページに不一致キーワードが「含まれない」場合は
　　　　　　' 電話番号掲載ありと判断し、関数の戻り値に True をセット
　　　　　　If InStr(mIE.Document.body.innerText, UNMATCH_KEYWORD) = 0 Then
　　　　　　　　ExistPhonenum = True
　　　　　　End If
　　　　End If
　　End With

End Function

お礼

ありがとうございます。これでやってみます！

回答No.1

noname#198951

HSPでブラウザにデータを渡すプログラムを作るか、スクリプトを実行できる
Webブラウザでスクリプトを組むか。
旧Sleipnirで作るのが楽かもしれないけど、プログラムを組んだ事がないと
同じかもしれないなぁ。

以前本屋のサイトに書籍番号を渡して本のタイトル、出版社名,著者などを
自動で登録していくプログラムがあったけど仕組みはそれと同じかな？