VBAを使ってHTMLソースから特定の文字を抽出2

質問

前回ExcelでVBAを使って「http://www.nankankeiba.com/calendar/201204.do」のサイトからHTMLソースから<em></em>タグ内の<a href="URL">のURL情報だけを抽出するコードを教えて頂きました。
そこで、取り込んだデータの更に下に「http://www.nankankeiba.com/calendar/201210.do」からも同じように<em></em>タグ内のURLデータを取得して表示したいのですが、ページ移動しても同じ情報を取得したり上手くいかないのでアドバイス頂けないでしょうかm(_ _)m

上のURLだけを取り込むコードはこちらになります。
http://uproda.2ch-library.com/800072670/lib800072.txt

イメージとしてこの様にしたいです。
http://uproda.2ch-library.com/800071Xz0/lib800071.jpg

回答No.1

mitarashi · ベストアンサー

前のご質問に回答した者ですが、他のサイトは見に行かない主義なので、外していたら悪しからず。という事で前回のURLを載せておきます。
http://okwave.jp/qa/q8648361.html
ループ変数を使うのが面倒くさいというものぐさ（死語？）コードです。
A列に年月？、B列にHyperlink先を入れています。

'Microsoft Internet Control
'Microsoft HTML Object Library
'に参照設定

Sub test()
Dim ie As InternetExplorer
Dim doc As IHTMLDocument
Dim docPart As IHTMLDocument
Dim chNode As IHTMLElement
Dim chNodes As IHTMLElementCollection
Dim chNodes1 As IHTMLElementCollection
Dim dateArray As Variant, myDate As Variant
Dim myCell As Range
Const urlSeed As String = "http://www.nankankeiba.com/calendar/myDate.do"

dateArray = Array("201204", "201210")
Set myCell = ThisWorkbook.Sheets("Sheet1").Range("A1")
For Each myDate In dateArray
Set ie = CreateObject("InternetExplorer.Application")
With ie
.navigate Replace(urlSeed, "myDate", myDate)
While .Busy Or .readyState <> 4: DoEvents: Wend
End With
Set doc = ie.document
Set chNodes = doc.getElementsByTagName("EM")
Application.ScreenUpdating = False
For Each chNode In chNodes
Set docPart = New HTMLDocument
docPart.write chNode.outerHTML
Set chNodes1 = docPart.getElementsByTagName("A")
myCell.Value = myDate
myCell.Offset(0, 1).Value = Replace(chNodes1(0).href, "about:", "")
Set myCell = myCell.Offset(1, 0)
Next chNode
ie.Quit
Next myDate
Application.ScreenUpdating = True
End Sub

お礼

mitarashiさん回答ありがとうございます。前回に引き続きお世話になりますm(_ _)m
独学でVBAの勉強し始めたばかりなので、Replace関数での置換や、配列の要素でループするなどは勉強になりました。