質問: ウェブの検索結果を自動的にエクセルファイルに反映する方法 エクセルファイルに電話番号リストが入っています。 この電話番号を1つ1つ手作業で、ヤフー電話帳で検索し、 電話帳に掲載されていれば○、掲載が無ければ×を 入力してています。 この作業を自動的に行う方法はありますか? どんなプログラム、ソフトを用いる方法でもかまいません。 とにかく頭の痛くなる作業から誰か開放してください。
回答: こんにちは。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