質問: excel vbaでリンク切れをチェックしたい。 excel vbaでリンク切れをチェックしたい。 図のように、リンク一覧からリンクを調べ、問題なければ「○」を表示し、リンク切れの場合は「×」を表示したいんですが、どんなプログラムを組めばよいですか? よろしくお願いします。
回答: 誰もレスを付けないと思いましたので、こちらでも作りましたのでアップしておきます。 #1の方とは、少し意味が違う部分があるかと思います。 以前、ここの掲示板で出したことがあると思うのですが、もう見つかりません。 一応、今回は、自分用で作ってみました。プロバイダからクレームが付きそうな気がしましたが、実行してしまいました。常識の範囲でお使いください。あまり速くはありませんが、ハングはしませんでした。 リンク先のチェックは、838件を一気にチェックしてしまいましたが、これほどはやらないほうが良いかもしれません。100件やって休むとかしたほうが良いような気がします。 ユーザー定義関数の戻り値は、いくつかあります。ステータス200は、◯ですが、その他は、種類がいろいろありますので、×にせずに数値や文字にしました。基本的に、ステータスコードの200は、全部返しました。 数字については、ステータス・コード表をごらんになってください。 http://www.asahi-net.or.jp/~ax2s-kmtn/ref/status.html 例: 404 サイトがなくなっています。 403 アクセス権限がないということですから、ログインしなければ分からないかもしれません。 他にも、いくつか種類が出てきます。 n.a と出るのは、サーバーが受け付けないものだと思います。 アンチウィルスソフトで、禁止区域に入った時は、メッセージが出てきました。しかし、そのままで続いていきます。 このマクロ使用中でも、スクロールは可能です。 場所は標準モジュールです。 ''//-- private declare sub sleep lib "kernel32.dll" (byval dwmilliseconds as long) private objhttp as object sub main_urlchecking() dim c as range dim i as long ''microsoft winhttp service, version 5.1 '参照設定する場合 ''set objhttp=new winhttp.winhttprequest ' for each c in range("b2", cells(rows.count, 2).end(xlup)) if lcase(c.value) like "http://*" then c.offset(, 1).value = checkurl(c.value) sleep 200 'wait を掛ける doevents 'escで離脱できるようにする。 end if next set objhttp = nothing end sub function checkurl(byval strurl as string) as variant dim num as variant on error goto errhandler if objhttp is nothing then set objhttp = createobject("winhttp.winhttprequest.5.1") end if objhttp.open "get", strurl, false objhttp.send if objhttp.status = 200 then checkurl = "◯" else checkurl = objhttp.status end if exit function errhandler: if err() <> 0 then checkurl = "n.a" end if end function ''//-- なお、今度は、これを、ハイパーリンクのリストに反映しないといけないのかな?