質問: 上記のウェブページにアクセスして全リンクを取得したいです。 今だと(全43,619件)リンクあるので、このリンクを取得したいと思っています(1ページに表示されているリンクのみ取得したいのではありません)。uwscもしくはVBAもしくはVBのWebBrowserコントロールで実現できる方法をお教えください。
回答: ``` Sub Link情報を取得する() '次へのボタンを押す。 Dim objIE As Object Dim strURL As String Dim strNEXT As String '次に表示するURL Dim i As Integer Dim nYLINE As Integer 'IEのオブジェクトを作成する Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True '初期ページを代入 strNEXT = "" 'URL代入 nYLINE = 10 '10行目からせっとするので While strNEXT <> "" '次のURLが入っている間まわる 'ページを開く(.Navigateで表示する。) objIE.Navigate strNEXT 'アドレスを渡し表示する '読み込み完了となるまで、ループする。 While objIE.ReadyState <> 4 Or objIE.Busy DoEvents Wend '↑これだと、広告画像の表示を待つから、クールじゃないなぁ。 ' 'リンクを探す 'リンク数分まわす A列にアンカーテキスト B列にURLを書く strNEXT = "" '次のURLを初期化 '上の次へがくるまで、空読み。 For i = 0 To objIE.Document.Links.Length - 1 '次へが見つかったら、抜ける※ここから下に質問があるので、、、、 If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then 'テキストが 次へ strNEXT = objIE.Document.Links(i).href 'URL(次へ)を代入 Exit For 'ループを抜ける End If '↑あっ、これだと、最後のページが取れないか、、、 Next i For i = i + 1 To objIE.Document.Links.Length - 1 'セット条件を があるか?にする。 If Left(objIE.Document.Links(i).href, 19) = "" Then Cells(nYLINE, "A") = "'" & objIE.Document.Links(i).innerText 'テキスト Cells(nYLINE, "B") = objIE.Document.Links(i).href 'URL nYLINE = nYLINE + 1 'セット位置を+1する End If '2回目の次へが見つかったら、強制的に抜ける※2回目の次へは質問よりしたなので、、 If Left(objIE.Document.Links(i).innerText, 2) = "次へ" Then 'テキストが 次へ Exit For 'ループを抜ける End If Next i Cells(nYLINE, "A").Select '普通イラナイケド、進行状況見たいので、、、 Wend objIE.Quit 'IEを閉じる End Sub ``` 問題点1.巡回中、データ取得中に新しい質問が上がったとき、1つデータが増えるので、重複して取得してしまう。 問題点2.次へ、、で判断しているので、最終ページ。 問題点3. 画像Offにしてないので、広告・バナーの読み込みまで待ってしまい、時間がかかる。 ※実際、最後まで、テストしてません。※Windows XP IE8 Excel2003 で 約20ページテストしました。 が、時間がかかるので、問題点1は必ず、発生すると思いますよ、、、 叩き台として、使ってみてください。 ※手前味噌のサンプル叩き台は、 を変更しました。 バグなどが残っていたら、スミマセン。 うまく、動作することを願いつつ、失礼します。