ＶＢＡにて：開いているＩＥのアドレスを取得するには？

セルに入力してあるアドレスを利用して、ＶＢＡからＩＥを開き、そのサイトを開くことが出来ます。

ところが、そのアドレスが現在は使われてなくて、
”お探しのページが見つかりませんでした”
と表示されることがあります。

この時、ＩＥをＶＢＡから閉じたいのですが、その判断方法として、
セルのアドレスとＩＥに表示されているアドレスが異なる
ことを利用しようと考えています。

そのために、ＩＥのアドレスの取得方法を知りたいのです。
ご存知の方お願いします。

No.1 回答者： ja7awu 回答日時： 2004/03/20 10:57

質問内容にズバリのレスにはなっていませんが・・・

IEにURLを指定する前にチェックした方が合理的と思います。
「お探しのページが見つかりませんでした」になるまで、ちょっと時間が
かかると思いますので、URLが変わるタイミングの処理も必要かと思います。

もっといい方法があるかも知れませんが、Webクエリを使う方法で如何でしょうか。

例えば、
・ "URL_CHK" という名前のシートを準備します。
・ そのシートに"URL_CHK"というQueryTableを作成し、非表示にします。
　(１回だけWebQeryAdd()を実行すれば、作成されます。)
・ 下記　URL_ADD_CHK()を実行すれば３行目で指定したセルに入力されている
　URLアドレスが、存在するかどうかを表示します。

Sub URL_ADD_CHK()
Dim url As String
url = Worksheets("Sheet1").Range("A1").Value
On Error Resume Next
With Worksheets("URL_CHK").QueryTables("URL_CHK")
　　.Connection = "URL;" & url
　　.WebSelectionType = xlAllTables
　　.WebFormatting = xlWebFormattingAll
　　.WebPreFormattedTextToColumns = True
　　.WebConsecutiveDelimitersAsOne = True
　　.WebSingleBlockTextImport = False
　　.WebDisableDateRecognition = False
　　.Refresh BackgroundQuery:=False
End With
If Err.Number > 0 Then
　　MsgBox "URLアドレスは存在しません。"
Else
　　MsgBox "URLアドレスは存在します。"
End If
End Sub

'-----------------

Sub WebQeryAdd() 'Webクエリを作成する(１回だけ実行)
Worksheets("URL_CHK").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
　　"URL;http://abcd.co.jp", Destination:=Range("A1"))
　　.Name = "URL_CHK"
nd With
End Sub

この回答へのお礼

回答ありがとうございます。
なんか凄いですね。

確認したところ以下のようになりました。

「ページを表示できません」の場合
アドレスは存在しません。と出ます。

「お探しのページは見つかりませんでした」の場合
アドレスは存在します。と出ます。

今回知りたいのは、
「お探しのページは見つかりませんでした」の場合です。
例えば、http://kkk.hp.infoseek.co.jp/25.htmlです。（適当に作りました）

お礼日時：2004/03/20 13:43

No.2 回答者： ja7awu 回答日時： 2004/03/20 11:03

＃１ですが　あれっ　 Excelのことですよね。

違っていたら無視してください。

この回答へのお礼

Excelのことなので、ＯＫです。

お礼日時：2004/03/20 13:45

No.3 ベストアンサー 回答者： ja7awu 回答日時： 2004/03/20 18:46

> 今回知りたいのは、「お探しのページは見つかりませんでした」の場合です。

> 例えば、http://kkk.hp.infoseek.co.jp/25.htmlです。

そうなんですか。
それでは、こんな感じになると思います。
Msgboxの所は、それぞれの処理を記述します。

Sub URL_ADD_CHK()
Dim url As String
url = Worksheets("Sheet1").Range("A2").Value
On Error Resume Next
With Worksheets("URL_CHK").QueryTables("URL_CHK")
　　.Connection = "URL;" & url
　　.WebSelectionType = xlAllTables
　　.WebFormatting = xlWebFormattingAll
　　.WebPreFormattedTextToColumns = True
　　.WebConsecutiveDelimitersAsOne = True
　　.WebSingleBlockTextImport = False
　　.WebDisableDateRecognition = False
　　.Refresh BackgroundQuery:=False
End With
If Err.Number > 0 Then
　　　　MsgBox "URLアドレスは存在しません。"
Else
　　If Not Worksheets("URL_CHK").Cells. _
　　　　Find("お探しのページは見つかりませんでした", _
　　　　　　lookat:=xlPart) Is Nothing Then
　　　　MsgBox "お探しのページは見つかりませんでした。"
　　Else
　　　　MsgBox "見つかりました。" 'ここに見つかった時の処理を記述
　　End If
End If
End Sub

この回答へのお礼

回答ありがとうございます。

うまく行きました。

お礼日時：2004/03/21 06:54

No.4 回答者： ja7awu 回答日時： 2004/03/20 19:00

現在のコードは、セルA2のURLになっておりますからテストするときは気をつけてね。

直すの忘れました。
　　↓　　　　　　
url = Worksheets("Sheet1").Range("A2").Value

この回答へのお礼

回答ありがとうございます。

動かないので最初悩みました。汗）

お礼日時：2004/03/21 06:55