EXCELの表にURLが登録してあり、そのURLのリンク先が有効になっているか？確認を
したいのですが、VBでできますか？

下記コードでホームページを表示するところまではできましたが、リンク先が有効、
無効の取得方法がわかりません。
ご存知の方がおりましたら、教えて下さい。
よろしくお願いします。

sURL = xlSheet.Range("D" & i).Value　'excelの値を取得
If sURL <> "" Then　　　　　　　　　　'値を取得したらホームページを表示
    WebBrowser1.Navigate sURL  
End If

自己レスです。
下記コードで解決しました。
（効率のいいやり方があったら教えて下さい。）

If sURL <> "" Then
    lblURL.Caption = sURL       'URL表示
    WebBrowser1.Navigate sURL   'ホームページ表示
            
    '15秒待つ
    StartTime = timeGetTime
    Do
        DoEvents
    Loop While (timeGetTime - StartTime < 15000)
            
    Text1.Text = WebBrowser1.Document.body.innerHTML    'HTMLソースを文字列として取出す
    If InStr(Text1.Text, "ファイルが見つかりません") <> 0 _
        Or InStr(Text1.Text, "ページを表示できません") <> 0 _
        Or InStr(Text1.Text, "ページが見つかりません") <> 0 Then
        xlSheet.Range("D" & i).Interior.ColorIndex = 3  '赤
    ElseIf InStr(Text1.Text, "URLがかわりました") <> 0 _
        Or InStr(Text1.Text, "URL変更") <> 0 _
        Or InStr(Text1.Text, "ページは移動") <> 0 _
        Or InStr(Text1.Text, "URLに移動") <> 0 Then
        xlSheet.Range("D" & i).Interior.ColorIndex = 1  '黄
    End If
End If

ちょっと気になったので質問します。
ネットあまり詳しくないので変な質問だったらゴメン

>     '15秒待つ
なぜ15秒なのでしょう？
時間経過での判断は、
通信速度とか環境に左右されないのでしょうか？

返信遅くなってしまって、ごめんなさい。

> >     '15秒待つ
> なぜ15秒なのでしょう？
> 時間経過での判断は、
> 通信速度とか環境に左右されないのでしょうか？

今回は1台のPCでしか実行しません。また、通信トラブル等がない限りレスポンスは
あまり変わらない環境にあります。
実行するのも、私や近くの人が行うので、何かあれば直ぐ対応でき、工数をかけて
まで完成度の高いものを望まれていないので、このようにしました。
15秒というのは、実行したところ15秒ならページが表示できるのでそうしました。
稀に、表示できないホームページもあります。
そういう場合は、更に待ち時間を増やすといった対策をとりました。
（待ち時間は、実際使ってみて不都合を感じたら修正すればいいかな？程度で考えて
います）

もし、今回のプログラム以外でおすすめの方法があったら教えだ下さい！
まだまだVB経験は浅いので、知らない事がたくさんあり、アドバイス大歓迎です。

> 15秒というのは、実行したところ15秒ならページが表示できるのでそうしました。
> もし、今回のプログラム以外でおすすめの方法があったら教えだ下さい！

下記ではどうですか？
http://www.bcap.co.jp/hanafusa/logbbs/wforum.cgi?mode=allread&no=6255#6264

> 下記ではどうですか？
> http://www.bcap.co.jp/hanafusa/logbbs/wforum.cgi?mode=allread&no=6255#6264

やってみましたが、直ぐに出来そうではないみたいです。
悩みながらやってみます。
できたら、報告しますのでお待ち下さい

> > 下記ではどうですか？
> > http://www.bcap.co.jp/hanafusa/logbbs/wforum.cgi?mode=allread&no=6255#6264

一応できたのですが、上手くいかない時があるので、教えて下さい。

ソースの一部を表記します。
------------------------------------
WebBrowser1.Navigate sURL1   'ホームページ表示              
Do Until (WebBrowser1.ReadyState = READYSTATE_COMPLETE And Not WebBrowser1.Busy)
    DoEvents
Loop
-------------------------------------

ほとんどは、WebBrowser1.ReadyState = READYSTATE_COMPLETEで処理が進みますが、同じURLを表示
していても、WebBrowser1.ReadyState = READYSTATE_LOADINGと、ずっとこの値のまま処理が進まない
時があります。

ネットで検索して調べてみましたが、WebBrowser1.ReadyState = READYSTATE_LOADINGの意味もわかり
ませんでした。（ヘルプではでてきませんが、それが普通ですか？）
参考URL又は、READYSTATE_LOADINGの意味がわかりましたら、教えて下さい。
よろしくお願いします。

http://www.bcap.co.jp/hanafusa/logbbs/wforum.cgi?mode=allread&no=6255#6264

の下記を試して見てください。

   1.  『.Busy = False』まで待機してから、
   2.  『Not .Document Is Nothing』まで待機し、最後に
   3.  『.Document.readyState = "complete"』まで待機する。

多くの場合下記ですましているようです。それでもだめなら魔界の仮面弁士さんの
方法でどうぞ

Do While objIE.busy
Loop

Do While objIE.Document.readyState <> "complete"
Loop

又、上記1.2.3の「」内の語句をキーワードに検索すればいくらでもサンプルが
でてきますよ。（定番の処理なので）

アドバイス頂いたように試してみましたが、HTMLのコードを取得できていない状態で、
次の処理へ移ってしまってるみたいです。（花ちゃん、魔界の仮面弁士さん両方とも）
何か根本的に書き方がおかしいのでしょうか？

ソースの修正箇所の確認です。
---修正前---
WebBrowser1.Navigate sURL1   'ホームページ表示              
Do Until (WebBrowser1.ReadyState = READYSTATE_COMPLETE And Not WebBrowser1.Busy)
    DoEvents
Loop

---修正後---
WebBrowser1.Navigate sURL1   'ホームページ表示
                
Do While WebBrowser1.Busy
Loop
                
Do While WebBrowser1.Document.ReadyState <> "complete"
Loop

※Do　Loopを修正するだけで、他はさわらないですよね？

ちなみに、Do　Loopの後はコールで下記を呼び出して、リンク切れか判断しています。
花ちゃん、魔界の仮面弁士さんの場合、リンク切れでなくても、●●●印の処理を通ってきて
しまっています。また、処理速度も"修正前"と比較すると一瞬にして終わります。
Call check(i)

Private Sub check(i)
    Text1.Text = WebBrowser1.Document.body.innerHTML    'HTMLソースを文字列として取出す
    If InStr(Text1.Text, "ファイルが見つかりません") <> 0 _
        Or InStr(Text1.Text, "ページを表示できません") <> 0 _
        Or InStr(Text1.Text, "ページが見つかりません") <> 0 _
        Or InStr(Text1.Text, "Object not found") <> 0 _
        Or InStr(Text1.Text, "Not Found") <> 0 _
        Or InStr(Text1.Text, "The page cannot be found") <> 0 Then
        xlSheet.Range("D" & i).Interior.ColorIndex = 3  '赤●●●
    ElseIf InStr(Text1.Text, "URLが変わりました") <> 0 _
        Or InStr(Text1.Text, "URL変更") <> 0 _
        Or InStr(Text1.Text, "URLが変更") <> 0 _
        Or InStr(Text1.Text, "ページは移動") <> 0 _
        Or InStr(Text1.Text, "移動しました") <> 0 _
        Or InStr(Text1.Text, "移動いたしました") <> 0 _
        Or InStr(Text1.Text, "ホームページ移転") <> 0 _
        Or InStr(Text1.Text, "URLに移動") <> 0 Then
        xlSheet.Range("D" & i).Interior.ColorIndex = 5  '青
    End If
End Sub

ネット検索でも調べてみますが、何かお気づきの点があったら教えて下さい。

Private Sub Command1_Click()
    sURL1 = "http://www.bcap.co.jp/hanafusa/in.html"
    WebBrowser1.Navigate sURL1
              
    Do While WebBrowser1.Busy
        DoEvents
    Loop
                
    Do While WebBrowser1.Document.ReadyState <> "complete"
        DoEvents
    Loop
    Call check(1)
End Sub

試してみましたが、問題なく取得できています。

下記方法で解決しました、ありがとうございました。
何故かは結局わかりませんでした。

>     sURL1 = "http://www.bcap.co.jp/hanafusa/in.html"
>     WebBrowser1.Navigate sURL1

　　　'----ここから追加----
　　　'1秒待つ
      StartTime = timeGetTime
      Do
          DoEvents
      Loop While (timeGetTime - StartTime < 1000)
　　　'----ここまで----
                
>     Do While WebBrowser1.Busy
>         DoEvents
>     Loop
>                
>     Do While WebBrowser1.Document.ReadyState <> "complete"
>         DoEvents
>     Loop
>     Call check(1)
> End Sub