エクセルでURLに特定文字が含まれるか調べる方法

質問

複数のURL(webページ)から特定文字が含まれているURLのみを調べる方法について教えてください。

海外サイトの調査候補URLを複数用意し、そのURLのページソースに「news」という特定文字列が含まれているURLを抽出する方法として、エクセルのマクロで以下を試してみました。
----------
Sub KeyWord_Search()
　Dim objHTTP As Object
　Dim i As Long
　Const strKW As String = "news"
　Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
　With objHTTP
　　For i = 1 To Range("A1").End(xlDown).Row
　　　.Open "GET", Cells(i, 1).Value, False
　　　.Send
　　　If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
　　Next
　End With
　Set objHTTP = Nothing
End Sub
----------

きちんと抽出されるURLもあれば、以下のようなエラーが発生するURLもあります。
----------
実行時エラー'-2147023783(80070459)':
Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。
----------

恐らく文字コードの問題だと想像していますが、マクロについて全く知識がないため解決方法がわかりません。なお、上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。

また、存在しないURLと「処理がタイムアウト」するURLは処理から除外したいと考えいます。

よろしくお願いします。

回答No.9

DOUGLAS_ · ベストアンサー

＃最初にお断わりしておきます。
＞ここまで親切に対応して下さって誠にありがとうございます。
とのことですが、私は、プロフィールに書いておりますように、「自分自身のパソコンのスキルを向上するためにこちらに参加して」いるのですから、そのようなお気遣いは無用です。

　webdesign254 さんがお尋ねのご質問自体が、汎用性があり、私自身も役に立つときがあるかも知れませんし、また、他の読者の方にとっても、有為な内容になると判断されたから回答させていただきましたが、同じようなご質問でも、ご質問者さん独自の用に特化されたような（汎用性のない）内容でしたら、ここまでの回答はいたしません。

------------------------------------------------------

　さて、
＞A1セルを処理しない
の件ですが、これは、
For i = 2 ～～
を
For i = 1 ～～
にすればＯＫです。

------------------------------------------------------

＞マクロは基礎から知識ゼロ
とのことですが、元々のコードと改変されたものの何処が変わったかというようなことを、比較する癖をお付けになったら、処理や操作が変わった原因も分かるようになりますし、そういうところから、スキルがアップするかと存じますので、是非、そういう習慣を付けてください。

　コードの比較の仕方は、
１）エクセルのワークシートＡ列に元々のコードをコピペ
２）Ｂ列に新しいコードをコピペ
３）Ｃ列に「=A1=B1」のような式を入れて、これを最終行までコピー
４）以上で、変わったところの行は、Ｃ列の値が「FALSE」になりますので、何処が変わったのかが一目瞭然となります。

　このヤリカタは、コード自体に行の追加・削除があった場合は、比較が難しくなりますので、ホントは、もっと複雑な式をＣ列に入れるべきですが、取り敢えずは、そのようにして比較するということを覚えてください。
　ちなみに、「複雑な式」というのは、下記です。
=INDIRECT(ADDRESS(ROW(),1))=INDIRECT(ADDRESS(ROW(),2))

------------------------------------------------------

　ついでに
＞エラーの詳細が詳しくわかった方が・・・
の件ですが、
＞のところを、
＞～～～～～～
＞このように変更してみました。
とするとお書きなので、ちょっとビックリいたしました。

　そこに羅列された「Case = ～～」の数字の部分ですが、概ねすべてのステータスが網羅されていて、その点についての知識がおありなのだなと思ったのですが、ただ、「200」はいいとしても、「402」が抜けていました。

　で、ここは、ズラ～～っとコードを並べるのではなくて、ほぼ「全て」のステータスを書き出すようにするわけですから、
Select Case .Status ～～～ End Select
の部分を、全面的に書き直しましょう。

　つまり、「Case 200 とそれ以外」ということにしてしまえば、コードの記載が下記の２行で済んでしまいます。
Case Else
Cells(i, 2).Value = .Status ～～

------------------------------------------------------

　ということで、新しいコードは、下記です。

　ただし、
＞タイムアウトを設定しないまま使用する方がよい
とのことですので、関連のコードも削除しました。

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

Sub KeyWord_Search()
　　Dim objHTTP As Object
　　Dim i As Long
　　Const strKW As String = "news"
　　Set objHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
　　With objHTTP
　　　　For i = 1 To Range("A1").End(xlDown).Row
　　　　　　Cells(i, 2).Select
　　　　　　If Cells(i, 2) = "" Then
　　　　　　　　.Open "GET", Cells(i, 1).Value, False
　　　　　　　　On Error Resume Next
　　　　　　　　.Send
　　　　　　　　Select Case .Status
　　　　　　　　　　Case 200
　　　　　　　　　　　　Cells(i, 2).Value = " なし"
　　　　　　　　　　　　If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = " あり"
　　　　　　　　　　Case Else
　　　　　　　　　　　　Cells(i, 2).Value = .Status & ":" & .statusText
　　　　　　　　End Select
　　　　　　　　.Abort
　　　　　　End If
　　　　　　If Err.Number <> 0 Then Cells(i, 2).Value = Err.Description
　　　　　　If Err.Number = -2147483638 Then Cells(i, 2).Value = "タイムアウト"
　　　　　　On Error GoTo 0
　　　　Next
　　End With
　　Set objHTTP = Nothing
End Sub

お礼

たった今最終の動作チェックを終えましたが、問題なく処理できることを確認いたしました。
今回のコードはかなり優秀で、同様のことを実現したい他の読者さんにとっても大きな助けになると思います。
HTTPステータスコードを一括で調べたい時、といった使い方もできそうです。

＞＞マクロは基礎から知識ゼロ
＞とのことですが、元々のコードと改変されたものの何処が変わったかというようなことを、比較する癖をお付けになったら、処理や操作が変わった原因も分かるようになりますし、そういうところから、スキルがアップするかと存じますので、是非、そういう習慣を付けてください。

おっしゃる通りNo.4のコードが「For i = 1」となっていることに今気が付きました。
自分のスキルアップのためにも比較する癖をつけていきたいと思います。
エクセルのコード比較のやり方は、こんな使い方もあるのだと驚きました。

（今まで私の場合は宝の持ちぐされでしたが…他の読者さんの助けにもなるかと思い）WinMergeという文章比較のフリーソフトも、コードの比較に役立つかもしれません。

HTTPステータスコードに関しましては、例えば503の場合は一時的なサーバーダウンなので後でチェックするなど、HTTPステータスコードを確認できた方が対処できる選択肢が増えると思いました。

DOUGLAS_さん、本当にありがとうございました。

回答No.8

DOUGLAS_

DOUGLAS_ です。
＃これは、「回答No.7」の解説です。
＃このスレッドを参考にされる方のために、事の経緯を記しておきます。

【１】先ず、使用するプログラムですが、ご質問文内の中のコードでは、「WinHttpRequest」を用いていました。
　これが、お尋ねの「Unicode 文字のマッピング・・・」というエラーを返しましたので、代わりに、私の手許にあった資料から、「XMLHTTP」に替えてみると、お尋ねのエラーが発生しなくなりましたので、「回答No.4」のコード
http://okwave.jp/qa/q8121305.html#answer_seq_no4
を提示した次第です。

【２】次に、「エクセルがフリーズ」という問題が発生しましたので、調べてみますと、
http://webos-goodies.jp/archives/50548720.html
に
-- ここから引用 ---------------------------------------------------
XMLHttpRequest オブジェクトを再利用する際も、abort メソッドを呼び出す必要がある
-- ここまで引用 ---------------------------------------------------
と書かれておりましたので、【書き換え１】の代替策を提示しました。

　しかし、「発行済みのリクエストを中止」しないから「エクセルがフリーズ」したと結び付ける根拠がありませんでしたので、念のために、【書き換え２】のコードを提示した次第です。

【３】ところが、と申しますか、案の定、「エクセルがフリーズ」するようですので、一から考え直してみることにしました。

●●● ここからが本題ですが ●●●
　よくよく調べてみますと、
http://loafer.jp/mixi/diary/class.xsp?2006-07-20-22-26
に
-- ここから引用 ---------------------------------------------------
XMLHTTP は、・・・ 利用者が意図しないところで、Cookie や履歴の情報を使用してしまう危険がある ・・・ ServerXMLHTTP は、・・・ セキュリティ面で安全なように、Cookie やキャッシュなどの情報は一切共有しない。
-- ここまで引用 ---------------------------------------------------
と書いてありましたので、「XMLHTTP」ではなくて、「ServerXMLHTTP」を使うことにしました（「ServerXMLHTTP」でも【１】のエラーは回避できています）。

　実際に、それぞれでマクロを動かした後、インターネットキャッシュを掃除するフリーソフト（CCleaner）でクリーンアップしてみると、「XMLHTTP」は、キャッシュや Cookie が削除されましたが、「ServerXMLHTTP」は、削除すべきものが見出されませんでした。

　つまり、「エクセルがフリーズ」するのは、「キャッシュや Cookie」が蓄積した結果なのではないかと憶測したわけですが、これもその因果関係を証明する根拠はありません。
　しかし、「abort メソッド を加えたこと」・「ServerXMLHTTP に変更したこと」は、改悪ではなく、改善と思われますので、これはこれでよいかと存じます。

　さらに、
http://support.microsoft.com/kb/237906/ja
に
-- ここから引用 ---------------------------------------------------
XMLHTTP オブジェクトを使用して、他の Web サーバーにリクエストを送信する ・・・ と ・・・ さまざまな予期しない問題が発生する恐れがあります。
-- ここまで引用 ---------------------------------------------------
と書かれていますので、当たらずとも遠からずかと思っております。

　また、[Windows タスク マネージャ] から起動した [リソース モニタ] で確認してみると、ネットワークの送受信に関わる負担も「ServerXMLHTTP」の方が軽そうです（しかし、かなりの通信量ではありますが。。。ひょっとしたら、お使いのインターネット接続に関する通信速度等の関係でフリーズしているということもなきにしもあらずかも知れません）。
　なお、同じく [リソース モニタ] で確認してみても、ＣＰＵ の使用率は大したことありませんし、また、メモリの消費量も余り変わりませんので、ＣＰＵやメモリが原因でフリーズしているようにはありません。

【４】次に、最初のご質問にありました
＞存在しないURLと「処理がタイムアウト」するURLは処理から除外したい
という問題についてですが、「回答No.4」では、「存在しないURL」についは「スルー出来た」としながらも、「処理がタイムアウト」については、「よく分かりません」と逃げております。

　実は、「XMLHTTP」には、#2さんがお書きの「WaitForResponse メソッド」のような装備がありませんでしたので、
＞下記のコードをお試しになってから、不具合があれば、そのＵＲＬをお知らせください。
と書いた次第です。

　今回は、「XMLHTTP」ではなくて、「ServerXMLHTTP」を使うことにしましたので、[waitForResponse メソッド] が装備されているのですが、
http://msdn.microsoft.com/en-us/library/ms754586(v=vs.85).aspx
を見ると、「非同期操作が完了するまでの間、要求サーバーが実行を一時停止（私は、この意味がよく分かりません）」ということで、[Send メソッド] の後に指定するもののようです。

　ところが、実際には、[Send メソッド] のところで時間が掛かっているようですので、むしろ、[Send メソッド] の前に、タイムアウト値を設置するようになっている（上記ＵＲＬ）[setTimeouts メソッド] の方がよいのではと考えました。

　[setTimeouts メソッド] の構文は、
setTimeouts(resolveTimeout, connectTimeout, sendTimeout, receiveTimeout)
となっていて、それぞれ、「ドメインネームを解決し、サーバーへの接続を確立し、データを送り、レスポンスを受け取るための」タイムアウトミリ秒（1000で１秒）のようです（デフォルトは、それぞれ、無制限、60秒、30秒、30秒）。

　私の環境（Windows Vista Business 32ビット、Excel 2003、ＣＰＵ：1.83GHz×２、メモリ：３GB）でいろいろと試行した結果、<< 私の環境の場合では >>
objHTTP.setTimeouts 4000, 500, 500, 3000
（それぞれ、４秒、0.5秒、0.5秒、３秒）で、ほとんどのＵＲＬがタイムアウトすることなく読み込めました。

　というか、タイムアウトを設定するほどのこともないかと存じますので、何でしたら、
.setTimeouts 4000, 500, 500, 3000
の行は削除してください。

【５】さらに、エラーが発生した場合は、Ｂ列に、そのエラーの記述を吐き出すようにしましたので、ここをご覧ください。

　以上により、Ｂ列に吐き出される文字列は、
１）「strKW」があった場合は「あり」
２）なかった場合は「なし」
３）「存在しないURL」の場合は「不正なＵＲＬ」
４）「ServerXMLHTTP」のステータスが「200 = OK」・「404 = Not Found」以外の場合は、「問題あり」
５）「この操作を完了するのに必要なデータは、まだ利用できません。」というエラーの場合は、「タイムアウト」
６）その他のエラーの場合は、エラーの記述
になりますので、Ｂ列で並べ替えて（１～４）以外のセル（Ｂ列の値）を消して、また、マクロを実行すると、Ｂ列が空白の行のみ、再度、確認作業をするようにしております。
　「タイムアウト」になっても、再度試行すると、正常に読み込む可能性は大きいです。

お礼

セキュリティー面まで改善して下さってありがとうございます。
安心して使うことができます。

No.7の「この回答へのお礼」のところへ、今回のコードのテスト結果を記載いたしました。
また、一点だけお願いを書かせていただきました。
よろしくお願いいたします。

回答No.7

DOUGLAS_

DOUGLAS_ です。

　前回答を書いてから、いろいろと調査しましたが、何となく「フリーズ」の原因が見えてきましたので、全面的にコードを書き直してみました。
　したがって「回答No.6」はスルーなさってください。
　下記のコードを試行していただき、なおも、フリーズするようでしたら、その旨、お知らせください。

Sub KeyWord_Search()
　　Dim objHTTP As Object
　　Dim i As Long
　　Const strKW As String = "news"
　　Set objHTTP = CreateObject("Msxml2.ServerXMLHTTP.6.0")
　　With objHTTP
'タイムアウトを設定する場合は、下の行頭の「'」を削除してください。
'　　　　.setTimeouts 4000, 500, 500, 3000
　　　　For i = 2 To Range("A1").End(xlDown).Row
　　　　　　Cells(i, 2).Select
　　　　　　If Cells(i, 2) = "" Then
　　　　　　　　.Open "GET", Cells(i, 1).Value, False
　　　　　　　　On Error Resume Next
　　　　　　　　.Send
　　　　　　　　Select Case .Status
　　　　　　　　　　Case 200
　　　　　　　　　　　　Cells(i, 2).Value = " なし"
　　　　　　　　　　　　If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = " あり"
　　　　　　　　　　Case 404
　　　　　　　　　　　　Cells(i, 2).Value = " 不正なＵＲＬ"
　　　　　　　　　　Case Else
　　　　　　　　　　　　Cells(i, 2).Value = " 問題あり"
　　　　　　　　End Select
　　　　　　　　.Abort
　　　　　　End If
　　　　　　If Err.Number <> 0 Then Cells(i, 2).Value = Err.Description
　　　　　　If Err.Number = -2147483638 Then Cells(i, 2).Value = "タイムアウト"
　　　　　　On Error GoTo 0
　　　　Next
　　End With
　　Set objHTTP = Nothing
End Sub

お礼

前回のテストでフリーズしたものを含め、海外URL3281件をまとめて一度に処理しても今回のコード（No.7）ではフリーズしませんでした。
今回のコードの凄いところは、問題URLで処理が止まっても（問題部分のセルを指し示して一時中断になるため）対処をすれば処理を再開できることです。
以前のようにエクセルを再起動して処理を一からやり直す心配がありません。

すごいと思いました。ここまで親切に対応して下さって誠にありがとうございます。
ご提示されている情報源も専門知識ばかりで、予備知識があったとしても解読が決して簡単ではなかったと思います。
本当にありがとうございました。

タイムアウト設定に関しまして

タイムアウト設定（「'」を削除）をすると（タイムアウトを設定しなければ正常に処理されていたのに）タイムアウトになるURLが多くなりすぎましたので、タイムアウトを設定しないまま使用する方がよいと思いました。

また、エラーの詳細が詳しくわかった方が（私の場合は）「正常に処理できているかどうか」という不安が減るため、
----------
　　　　　　　　　　Case 404
　　　　　　　　　　　　Cells(i, 2).Value = " 不正なＵＲＬ"
----------
のところを、
----------
Case 100
Cells(i, 2).Value = "100"
Case 101
Cells(i, 2).Value = "101"
Case 201
Cells(i, 2).Value = "201"
Case 202
Cells(i, 2).Value = "202"
Case 203
Cells(i, 2).Value = "203"
Case 204
Cells(i, 2).Value = "204"
Case 205
Cells(i, 2).Value = "205"
Case 206
Cells(i, 2).Value = "206"
Case 300
Cells(i, 2).Value = "300"
Case 301
Cells(i, 2).Value = "301"
Case 302
Cells(i, 2).Value = "302"
Case 303
Cells(i, 2).Value = "303"
Case 304
Cells(i, 2).Value = "304"
Case 305
Cells(i, 2).Value = "305"
Case 307
Cells(i, 2).Value = "307"
Case 400
Cells(i, 2).Value = "400"
Case 401
Cells(i, 2).Value = "401"
Case 403
Cells(i, 2).Value = "403"
Case 404
Cells(i, 2).Value = "404"
Case 405
Cells(i, 2).Value = "405"
Case 406
Cells(i, 2).Value = "406"
Case 407
Cells(i, 2).Value = "407"
Case 408
Cells(i, 2).Value = "408"
Case 409
Cells(i, 2).Value = "409"
Case 410
Cells(i, 2).Value = "410"
Case 411
Cells(i, 2).Value = "411"
Case 412
Cells(i, 2).Value = "412"
Case 413
Cells(i, 2).Value = "413"
Case 414
Cells(i, 2).Value = "414"
Case 415
Cells(i, 2).Value = "415"
Case 416
Cells(i, 2).Value = "416"
Case 417
Cells(i, 2).Value = "417"
Case 500
Cells(i, 2).Value = "500"
Case 501
Cells(i, 2).Value = "501"
Case 502
Cells(i, 2).Value = "502"
Case 503
Cells(i, 2).Value = "503"
Case 504
Cells(i, 2).Value = "504"
Case 505
Cells(i, 2).Value = "505"
----------
このように変更してみました。

一点だけ問題があります。「A1セルを処理しないこと」です。
A2セルからA列の最終行まで処理を行いますが、なぜかA1セルのみスルーしてしまうことです。
ここまで完璧なコードですのでこれは些細な問題で、使い方を工夫（A1セルはスペースでも入力しておき、A2セルから下へ処理するURLを貼り付け）すればよい話です。
しかし、完璧なコードであるだけに、より完璧であった方がやはり嬉しいです。

もし、ほんの一部分を変更するだけでA1セルからの処理を実現できるなら、最後にぜひお願いします。
もちろんかなり手間がかかるような内容でしたら、現状のままで全く問題ありません。
よろしくお願いいたします。

回答No.6

DOUGLAS_

DOUGLAS_ です。

　代替案をお示しする前に、ちょっと気に掛かることができましたので、先ず、こちらにお返事をお願いいたします。

＞【書き換え２】を試したところ、フリーズする場合としない場合がありました。
として、いろいろなパターンをお示しくださいましたが、「？？件」と書かれた「？？」の内容は、単なる件数の違いではなくて、その件数に含まれるＵＲＬそのものが違うということはありませんか？

＞一度の処理件数が少ないほどフリーズの発生率が低下するのは間違いない
とはお書きですが、そもそも当初から問題となっている「フリーズ」は、件数の問題ではなくて、ＵＲＬの参照先に問題があるような気がしてきたのですが、いかがでしょうか？

＞【書き換え１】を試してみましたが、フリーズが発生しました。
とのことですので、「回答No.4」のコードにつきまして、下記の２点を訂正してみてください。

【１】
.Open "GET", Cells(i, 1).Value, False
の <<前>> に
.abort
の１行を追加してください。
【２】
For i = 1 To Range("A1").End(xlDown).Row
の後に、
Cells(i, 1).Select
の１行を追加してください。

　これにより、データを読みに行くときに、当該のＵＲＬがあるセルがアクティブになりますので、フリーズしたところのＡ列の行番号を目視で確認して、エクセルを再起動した後、そのセルにあったＵＲＬを確認してください。

　次に、そのＵＲＬをＡ１セルに配置して、同じマクロを実行してみてください。
　もし、Ａ１セルがアクティブな時点でフリーズした場合は、そのＵＲＬに問題があるということになりますので、そのＵＲＬをお知らせください。

　上記を試行の結果、前述の「Ａ列の行番号」あたりでフリーズした場合は、やはり「件数」の問題かも知れませんので、その際は、再度、考え直してみます。

お礼

ご丁寧な回答をありがとうございます。確認が遅くなり申し訳ないです。
No.7を読む前に取り急ぎ下記の部分に回答いたします。

＞【書き換え２】を試したところ、フリーズする場合としない場合がありました。
として、いろいろなパターンをお示しくださいましたが、「？？件」と書かれた「？？」の内容は、単なる件数の違いではなくて、その件数に含まれるＵＲＬそのものが違うということはありませんか？

----------
(1)189件（海外のURL）　…　22:28開始⇒22:36正常に完了
(2)216件（海外のURL）　…　22:40開始⇒23:29　※フリーズで断念
(3)69件（海外のURL）　…　22:40開始⇒22:49正常に完了
(4)85件（海外のURL）　…　23:09開始⇒23:28正常に完了
(5)1019件（日本のURL）　…　23:05開始⇒23:28正常に完了
(1)517件（海外のURL）　…　1:06開始⇒1:30正常に完了
----------
上記の(1)～(5)はURLグループを示しています。同じ数字の場合はURLが同一を意味します。

「その他、１０回程度試してフリーズは３回程度。」のうち、(1)を試したのは（ちょっと記憶があいまいですが）５回程度で(1)でフリーズしたのは１回以上です。

＞一度の処理件数が少ないほどフリーズの発生率が低下するのは間違いない
とはお書きですが、そもそも当初から問題となっている「フリーズ」は、件数の問題ではなくて、ＵＲＬの参照先に問題があるような気がしてきたのですが、いかがでしょうか？

絶対フリーズすると思って「(5)1019件（日本のURL）」を試したところフリーズしませんでしたので、URLが関係している部分は大きいと思います。ただ、(1)では517件でフリーズしないこともあれば、50件程度でフリーズしたこともありました。
（完全には何が原因か覚えていませんが）エクセルを再起動するなど、何かの拍子でフリーズしなかったりフリーズしたりしました。

回答No.5

DOUGLAS_

#1・#4 DOUGLAS_ です。

＞エクセルがフリーズ
とのことですので、先ず、下記をお試しください。

【書き換え１】
「回答No.4」のコードの
.Open "GET", Cells(i, 1).Value, False
の <<前>> に
.abort
の１行を追加してください。

--------------------------------ーーー

【書き換え２】
   上記でもフリーズした場合は、下記でお試しください。

＞一度に２０URLずつ２５回処理を行う場合、フリーズは発生しません。
とのことですので、「２０URLずつ・・・処理を行う」ようにコードを書き換えれば済むことかと存じます。

   下記のコードでも、なお、
＞エクセルがフリーズして何十分待っても完了しない
場合は、改めてお知らせください。
   その場合は、手動で、「一度に２０URLずつ２５回処理を行う」ような感じのコードに書き換えます。

Sub KeyWord_Search()
     Dim i As Long
     Dim objHTTP As Object
     Const strKW As String = "news"
     Do
         i = i + 1
         If Range("A" & i).Value = "" Then Exit Do
         If i Mod 20 = 1 Then Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
         With objHTTP
             .abort
             .Open "GET", Cells(i, 1).Value, False
             On Error Resume Next
             .Send
             Select Case Err.Number
                 Case 0
                     If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
                 Case -2146697211
                     Cells(i, 2).Value = "不正なＵＲＬ"
                 Case Else
                     Cells(i, 2).Value = "タイムアウト"
             End Select
             On Error GoTo 0
         End With
         If i Mod 20 = 0 Then Set objHTTP = Nothing
     Loop
     Set objHTTP = Nothing
End Sub

お礼

この度もご丁寧なお返事を下さりありがとうございます。
とても感謝しております。

【書き換え１】を試してみましたが、フリーズが発生しました。

【書き換え２】を試したところ、フリーズする場合としない場合がありました。
その結果は以下の通りです。

189件（海外のURL）　…　22:28開始⇒22:36正常に完了
216件（海外のURL）　…　22:40開始⇒23:29　※フリーズで断念
69件（海外のURL）　…　22:40開始⇒22:49正常に完了
85件（海外のURL）　…　23:09開始⇒23:28正常に完了
1019件（日本のURL）　…　23:05開始⇒23:28正常に完了
517件（海外のURL）　…　1:06開始⇒1:30正常に完了
その他、１０回程度試してフリーズは３回程度。

処理件数が少ないほどフリーズの発生率が減る感覚があります。
一度の処理件数を減らすほど処理時間の合計も短くなるのではないか、と仮説を立ててみました。
その結果は以下の通りです。あまり違いはありませんでした。

20件×1 = 18.4秒
10件×2 = 19.6秒
5件×4 = 21.3秒
2件×10 = 18.3秒
1件×20 = 18.7秒

しかし、一度の処理件数が少ないほどフリーズの発生率が低下するのは間違いないと思います。

＞ 下記のコードでも、なお、
＞ ＞エクセルがフリーズして何十分待っても完了しない
＞ 場合は、改めてお知らせください。
＞ その場合は、手動で、「一度に２０URLずつ２５回処理を行う」ような感じのコードに書き換えます。

またお手数をかけてしまい恐縮なのですが、ぜひお願いさせていただけないでしょうか。

もし、書き換えの手間がそれほど変わらない場合、
「一度に１URLずつデータのある最終セルまで処理を行う」方がフリーズの可能性を減らせるような気がします。
（書き換えの手間が増えてしまう場合は２０URLずつで大丈夫です）

よろしくお願いいたします。

回答No.4

DOUGLAS_

#1 DOUGLAS_ です。
＃お返事が遅くなりまして申し訳ございません。

＞実行時エラー'-2147023783(80070459)':
＞存在しないURL
はスルー出来たかと存じます。

＞「処理がタイムアウト」するURL
につきましては、何を以て「処理がタイムアウト」なのかよく分かりませんので、下記のコードをお試しになってから、不具合があれば、そのＵＲＬをお知らせください。

Sub KeyWord_Search()
　Dim objHTTP As Object
　Dim i As Long
　Const strKW As String = "news"
　Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
　With objHTTP
　　For i = 1 To Range("A1").End(xlDown).Row
　　　.Open "GET", Cells(i, 1).Value, False
　　　On Error Resume Next
　　　.Send
　　　Select Case Err.Number
　　　　Case 0
　　　　　If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
　　　　Case -2146697211
　　　　　Cells(i, 2).Value = "不正なＵＲＬ"
　　　　Case Else
　　　　　Cells(i, 2).Value = "タイムアウト"
　　　End Select
　　　On Error GoTo 0
　　Next
　End With
　Set objHTTP = Nothing
End Sub

お礼

お忙しい中、時間を取って下さってありがとうございます。
お礼が遅くなってしまったことをお許しください。

500ほどのURLで何度も試してみました。
動作については全く問題がなかったです。

「存在しないURL」は100％分類できていますし、「タイムアウト」したURLに関しては後ほど自分で目視して再チェックすればよいと思いました。

ただ、一点だけカスタマイズ前のものに存在しなかった問題が発生しました。
相当の数のURLを一度に処理しようとすると、エクセルがフリーズして何十分待っても完了しないことです。

１０～２０くらいのURLを一度に処理するのは（カスタマイズ前のものより少し動作が遅いですが）問題なくスムーズに完了しました。
しかし、一度に処理するURL数が５０または１００、または５００程度の場合、フリーズが発生します。
５００のURLを、一度に２０URLずつ２５回処理を行う場合、フリーズは発生しません。

このフリーズはエクセルの設計上の処理性能の関係から、必然的なものでしょうか。

度々お手数をおかけして申し訳ないです。

回答No.3

kumatti1

> マクロは基礎から知識ゼロです・・・
では勉強されるか、業者に有償で発注されるしかないのでは。

お礼

確かにおっしゃる通りです。
甘えがあるのを承知の上でお願いしております。

回答No.2

kumatti1

> 少し原因が複雑かもしれません・・・
サーバーが文字コードを返さない場合は正しく認識出来ませんので自前で指定する事になります。
http://web.archive.org/web/20050310113902/http://www2.moug.net/app/bbs/message.php?cat=acm_v&id=20050219-000004

> 処理がタイムアウト
WaitForResponse メソッドでTimeout 値を設定するとか。
http://msdn.microsoft.com/en-us/library/windows/desktop/aa384106%28v=vs.85%29.aspx

> 存在しないURL
現状でも使われているStatus プロパティで判断するとか。

お礼

貴重な情報をありがとうございます。
問題解決への核心部分に到達しつつあるように思います。
各ページを読みながらどうカスタマイズするべきか悩んではみました。

しかし当方がマクロの文法知識ゼロの状態ですので、上記コードのどの部分と参考URLのどの部分を置き換えるべきなのか、参考URLのものをどうカスタマイズしてから置き換えるべきなのか、この辺が未知の世界です。

HTMLやCSSなら多少複雑な内容でも理解できるのですが、マクロは基礎から知識ゼロです・・・

回答No.1

DOUGLAS_

＞上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。
そのマクロを書いた DOUGLAS_ です。
http://okwave.jp/qa/q6120067.html#answer_seq_no3

＞また、存在しないURLと「処理がタイムアウト」するURLは処理から除外したいと考えいます。
につきましては、後ほど考えるとして、先ず、
＞実行時エラー'-2147023783(80070459)':
＞Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。
というエラーが出る ＵＲＬ をお差し支えなければお知らせいただけますでしょうか？

お礼

ご親切に対応して下さりありがとうございます。
とても嬉しいです。

例えば次のURLで「Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。」が発生します。
http://www.eu-orchestra.org/events.shtml

文字コードの問題と思って調べたところ「Unicode(UTF-8)」でした。

次のURLは普通に処理できるため異なる文字コードかと予測しましたが、実は同様に「Unicode(UTF-8)」でした。
http://abcnews.go.com/
http://www.bbc.co.uk/news/

少し原因が複雑かもしれません・・・
よろしくお願いします。