ＶＢＡ IE操作 スクレイピング

VBA IE操作について

こんばんわ。いつもお世話になっております。
初心者の質問ですが、先生方のご意見ご指導宜しくお願いいたします。

OS : windows7 , EXCEL2007

--------------------------------------------------------------
プロ野球のサイトにアクセスし、（セントラル・リーグ）の球団に在籍する選手
の画像を自動で取得するコードを作りたいと思っています。

(1)　2012年度 選手一覧　→　http://bis.npb.or.jp/players/　を開く
(2)　球団名のリンクをクリックして球団ページへ移動する
(3)　球団ページ内の選手名のリンクをクリックして選手ページへ移動する
(4)　選手紹介欄の画像を取得する

上記のような行程なのですが、(2)の球団数も6球団あります。
(4)の選手数にしても何十人もいますので、for ～ next でループさせたいと思っています。

このような場合IEで処理することは可能なのでしょうか？

参考サイトなどから沢山のお知恵をいただき、下記のようなコードを試してみたのですが、
エラーとなり、うまくいきませんでした。

sheet1
　　　　　　Ａ
1
2
3　　中日ドラゴンズ
4　　東京ヤクルトスワローズ
5　　読売ジャイアンツ
6　　阪神タイガース
7　　広島東洋カープ
8　　広島東洋カープ
9　　横浜DeNAベイスターズ


Sub Ｔｅｓｔ ()

Sub Graph_Down2()

Dim nmbr As Integer

nmbr = Range("A3").End(xlDown).Row - 2

Set objIE = CreateObject("InternetExplorer.Application") 'IEを開く
objIE.Visible = True
objIE.Navigate "http://bis.npb.or.jp/players/"

Do While objIE.ReadyState <> 4 'サイトが開くまで待機
Do While objIE.Busy = True
Loop
Loop


For i = 0 To nmbr

'表示されているサイトのアンカータグ一つずつを変数objにセット
For Each obj In objIE.Document.getElementsByTagName("a")
'Obj.innerTextと全機種名が一致すれば
If Trim(Range("A" & i + 3).Value) = Trim(obj.innerText) Then

'該当するタグをクリック
obj.Click 'ページジャンプ

'//

'移動したページの画像を取得する処理コードを書く



'//

objIE.GoBack '前のページへ戻る　　　'＊　ここでエラーになります
Exit For
End If
Next
Next i

' Set Obj = Nothing
' objIE.Quit
' Set objIE = Nothing

End Sub


上記コードですが、

ＩＥで2012年度 選手一覧を開く　→　Ａ３の球団名と一致したリンクをクリック　→　
中日ドラゴンズのページに移動　まではできています。


この先の処理についてご指導いただければと思います。
基礎ができていないど素人のため拙い説明ですが、
お分かりの方いましたら是非ご指導願います。

宜しくお願いいたします！

No.1 ベストアンサー 回答者： ki-aaa 回答日時： 2012/05/18 21:16

こんにちわ

>objIE.GoBack '前のページへ戻る　　　'＊　ここでエラーになります
これはobj.Click 'ページジャンプでリンク先に飛んだ場合はそうなるみたいですね。

また、私の環境ではobj.Click での処理は、
動作が不安定になるのでまったく違う方法を書きます。

Sub Graph_Down2()
Dim re As Object 'VBScript.RegExp
Dim mc As Object 'RegExp.Match
Dim mcmc As Object 'RegExp.Match
Dim url As String 'URLアドレス
Dim ret As String 'XMLHTTP.responsetext
Dim objIE, obj
Dim i As Long, j As Long, k As Long

Sheets("Sheet1").Cells.ClearContents
Set re = CreateObject("VBScript.RegExp")
re.Global = True

Set objIE = CreateObject("InternetExplorer.Application") 'IEを開く
objIE.Visible = True
objIE.Navigate "http://bis.npb.or.jp/players/"
Do While objIE.ReadyState <> 4 'サイトが開くまで待機
Do While objIE.Busy = True
Loop
Loop

ret = objIE.Document.body.innerHTML
' <a href="/teams/rst_d.html"> 球団のURL
re.Pattern = "<A href=""/(teams/rst_[dsgtc]b?\.html)"">"
Set mc = re.Execute(ret)
For j = 0 To mc.Count - 1
'Sheets("Sheet1")のA列にURLを書き出す。
Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
"http://bis.npb.or.jp/" & mc(j).SubMatches(0)
objIE.Navigate "http://bis.npb.or.jp/" & mc(j).SubMatches(0)
Do While objIE.ReadyState <> 4 'サイトが開くまで待機
Do While objIE.Busy = True
Loop
Loop

ret = objIE.Document.body.innerHTML
'<A href="/players/91595118.html"> 選手のURL
re.Pattern = "<A href=""/(players/\d+\.html)"">"
Set mcmc = re.Execute(ret)
For k = 0 To mcmc.Count - 1
'Sheets("Sheet1")のC列にURLを書き出す。
Sheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Offset(1) = _
"http://bis.npb.or.jp/" & mcmc(k).SubMatches(0)
Next k
Next j

Set obj = Nothing
objIE.Quit
Set objIE = Nothing
End Sub

Sub 画像を取得()
Dim objIE, obj
Dim i As Long, j As Long, k As Long
Set objIE = CreateObject("InternetExplorer.Application") 'IEを開く
objIE.Visible = True
'For i = 2 To Sheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To 5 'テストのため、取りあえず4回まわす。
objIE.Navigate Sheets("Sheet1").Cells(i, 3).Value
Do While objIE.ReadyState <> 4 'サイトが開くまで待機
Do While objIE.Busy = True
Loop
Loop
MsgBox "ここに画像を取得する処理コードを書く"
Next i
objIE.Quit
Set objIE = Nothing
End Sub

また、画像の取得は私の手に余りますので、
もう一度、質問をしてください。

この回答へのお礼

ありがとうございます。
しっかりとＵＲＬが取得できました。あとは画像取得のコードを考えていきたいと思います。
正規表現は苦手で、ずっと手を付けないままでしたが、
これを機に勉強したいと思います。
ありがとうございました。

また再度質問するかもしれませんが、
その時は宜しくお願いいたします。

お礼日時：2012/05/20 19:02