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

Question

複数の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は処理から除外したいと考えいます。

よろしくお願いします。

DOUGLAS_ · Accepted Answer

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

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

DOUGLAS_ · Answer

DOUGLAS_ です。＃これは、「回答No.7」の解説です。＃このスレッドを参考にされる方のために、事の経緯を記しておきます。【１】先ず、使用するプログラムですが、ご質問文内の中のコードでは、「WinHttpRequest」を用いていました。　これが、お尋ねの「Unicode 文字のマッピング・・・」というエラーを返しましたので、代わりに、私の手許にあった資料から、「XMLHTTP」に替えてみると、お尋ねのエラーが発生しなくなりましたので、「回答No.4」のコード http://oshiete.goo.ne.jp/qa/8121305.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」以外の場合は、「問題あり」５）「この操作を完了するのに必要なデータは、まだ利用できません。」というエラーの場合は、「タイムアウト」６）その他のエラーの場合は、エラーの記述になりますので、Ｂ列で並べ替えて（１～４）以外のセル（Ｂ列の値）を消して、また、マクロを実行すると、Ｂ列が空白の行のみ、再度、確認作業をするようにしております。　「タイムアウト」になっても、再度試行すると、正常に読み込む可能性は大きいです。

DOUGLAS_ · Answer

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

DOUGLAS_ · Answer

DOUGLAS_ です。

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

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

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

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

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

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

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

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

DOUGLAS_ · Answer

#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

DOUGLAS_ · Answer

#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

kumatti1 · Answer

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

kumatti1 · Answer

> 少し原因が複雑かもしれません・・・
サーバーが文字コードを返さない場合は正しく認識出来ませんので自前で指定する事になります。
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 プロパティで判断するとか。

DOUGLAS_ · Answer

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

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

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

＃最初にお断わりしておきます。

DOUGLAS_ です。

DOUGLAS_ です。

DOUGLAS_ です。

#1・#4 DOUGLAS_ です。

#1 DOUGLAS_ です。

> マクロは基礎から知識ゼロです・・・

> 少し原因が複雑かもしれません・・・

＞上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング