
No.2ベストアンサー
- 回答日時:
誰もレスを付けないと思いましたので、こちらでも作りましたのでアップしておきます。
#1の方とは、少し意味が違う部分があるかと思います。
以前、ここの掲示板で出したことがあると思うのですが、もう見つかりません。
一応、今回は、自分用で作ってみました。プロバイダからクレームが付きそうな気がしましたが、実行してしまいました。常識の範囲でお使いください。あまり速くはありませんが、ハングはしませんでした。
リンク先のチェックは、838件を一気にチェックしてしまいましたが、これほどはやらないほうが良いかもしれません。100件やって休むとかしたほうが良いような気がします。
ユーザー定義関数の戻り値は、いくつかあります。ステータス200は、◯ですが、その他は、種類がいろいろありますので、×にせずに数値や文字にしました。基本的に、ステータスコードの200は、全部返しました。
数字については、ステータス・コード表をごらんになってください。
http://www.asahi-net.or.jp/~ax2s-kmtn/ref/status …
例:
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
''//--
なお、今度は、これを、ハイパーリンクのリストに反映しないといけないのかな?
ご回答ありがとうございます。
無事に処理することが出来ました。
マクロ使用中でもスクロール出来るのはすごく良かったです。
大変助かりました。
ありがとうございました。
No.1
- 回答日時:
できました。
標準モジュールに以下のコードを記載し、
B2セルから下にチェックしたいURLを並べて実行してください。
URLはハイパーリンクでなくても構いません。
Sub test()
Dim req
Dim MyUrl As String
Dim cnt As Long
Dim i As Long
Dim MyRng As Range
Set req = CreateObject("Microsoft.XMLHTTP")
cnt = Cells(2, 2).CurrentRegion.Rows.Count
For i = 1 To cnt
Set MyRng = Range("B2").Cells(i, 1)
MyUrl = MyRng.Value
req.Open "GET", MyUrl, False
req.Send
' Debug.Print req.Status
If Not (req.Status >= 200 And req.Status < 300) Then
MyRng.Cells(1, 2).Value = "×"
Else
MyRng.Cells(1, 2).Value = "◯"
End If
Next i
End Sub
参考にさせていただいたページ
http://www.excel.studio-kazu.jp/kw/2010072916151 …
http://www.excel.studio-kazu.jp/kw/2005092716325 …
http://www.relief.jp/itnote/archives/excel-vba-c …

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
リンク切れチェックを行うマクロ
Excel(エクセル)
-
Excel でのリンク切れの探し方
Excel(エクセル)
-
【エクセル】ハイパーリンク先のチェック
Excel(エクセル)
-
4
EXCEL2000VBAでハイパーリンクの有無を調べたい。
Excel(エクセル)
-
5
EXCEL VBAで、URLを入力して、そのURLが存在するかどうか調べるような命令はあるでしょうか。
Visual Basic(VBA)
-
6
エクセルでのハイパーリンク切れについて
Excel(エクセル)
-
7
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
8
VBAで有効なURLのみ抽出する方法
Excel(エクセル)
-
9
エクセルでハイパーリンクのURLだけを文字抽出したい
Excel(エクセル)
-
10
URLのリンク切れをマクロを使って表示する方法を教えてください。
その他(プログラミング・Web制作)
-
11
VBスクリプトでIEの404 not foundエラーを検出する
Visual Basic(VBA)
-
12
EXCEL VBA 指定したファイルが存在しない場合メッセージボックスを表示させる
Access(アクセス)
-
13
Excel ハイパーリンクのURLを別のセルに表示したい。
その他(Microsoft Office)
-
14
Excelでセル参照したとき、書式も一緒に持ってくるには?
Windows Vista・XP
-
15
メッセージボックスのOKボタンをVBAでクリックさせたい
Visual Basic(VBA)
-
16
EXCEL VBAでたくさんのURLの一覧からHTTPレスポンスコードを取得したい。
Access(アクセス)
-
17
Webページを作るには、HTMLとCSSだけ出来れば大丈夫なのですか? JavaScriptのスキル
HTML・CSS
-
18
dockerとは? 新しい配属先でテレワークになり、テレワーク用のpcにdockerを入れたのですが
その他(プログラミング・Web制作)
-
19
プログラミング 処理速度
その他(プログラミング・Web制作)
-
20
EXCEL ハイパーリンク先を表示させるには
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
人気Q&Aランキング
-
4
private subモジュールを他のモ...
-
5
Form間の値の渡し方
-
6
Access VBA標準モジュールにつ...
-
7
ユーザー定義関数に#NAME?が返...
-
8
'Range'メソッドは失敗しました
-
9
Excel VBAで、ユーザーフォーム...
-
10
VBでグローバル変数を宣言するには
-
11
後付けTPMについて
-
12
モジュールとは何ですか
-
13
標準モジュールを削除したい。(...
-
14
VBA モジュールで共通に使う変...
-
15
モジュールとクラスの違いって...
-
16
本当にPublicな変数(配列で)
-
17
Tomcat マイナーバージョン移行...
-
18
モジュールからフォームのボタ...
-
19
【vba】フォームに書いてあ...
-
20
VBAで旧字体を異字体に一括で変...
おすすめ情報
公式facebook
公式twitter