vbaでのスクレイピングに関して

箇条書きで恐縮です。
只今下記、参考サイトから各企業のURLを抜き出し、各下層ページから”欲しい情報”を抜き出したいと考えております。

■参考サイト

■下層ページ（例）

■欲しい情報
代表者名
会社名
資本金
業種
人数
求人採用
企業HP

そして、現在各企業のURLを取得する際に困っています。
こちらのコードでURLが取得出来ない理由をご教示いただけますと幸いです

VBA
1Sub listPost()
2 
3Dim objIE As InternetExplorer 'IEオブジェクトを準備
4Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
5exlrow = 1
6
7'URLを取得
8For i = 1 To 140
9    objIE.Visible = True 'IEを表示
10    objIE.navigate "～～～～～～" & i 'IEでURLを開く
11
12    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち
13
14        DoEvents
15
16    Loop
17
18
19    Dim htmlDocURL As HTMLDocument 'HTMLドキュメントオブジェクトを準備
20    Set htmlDocURL = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット
21
22
23
24For V = 0 To 7
25    Dim elList As IHTMLElementCollection
26    Set elList = htmlDocURL.getElementsByClassName("list clearfix") 
27    Set elList = htmlDocURL.getElementsByClassName("col2") 
28   
29
30    'ここから
31
32    Dim el As IHTMLElement
33    For Each el In elList
34            Worksheets("Sheet1").Range("A" & exlrow + 1).Value = el.getElementsByTagName("a")(V).href
35    Next el
36
37    'ここまで
38
39    objIE.Visible = False
40    
41Next V
42
43Next i
44
45
46End Sub
47

行動規範の内容に同意します

回答1件

ベストアンサー

26行目の
Set elList = htmlDocURL.getElementsByClassName("col2")
が何をやりたかったのか分からなかったので、とりあえずコメントアウトして、
For Each el In elList
内で exlrow を加算してやるとうまくいきました。以下コードになります。

VBA

Sub listPost()

Dim objIE As InternetExplorer 'IEオブジェクトを準備
Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット
exlrow = 1

'URLを取得
For i = 1 To 5
    objIE.Visible = True 'IEを表示
    objIE.navigate  "～～～～～～" & i 'IEでURLを開く

    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち

        DoEvents

    Loop


    Dim htmlDocURL As HTMLDocument 'HTMLドキュメントオブジェクトを準備
    Set htmlDocURL = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット


For V = 0 To 140
    Dim elList As IHTMLElementCollection
    Set elList = htmlDocURL.getElementsByClassName("list clearfix")
'    Set elList = htmlDocURL.getElementsByClassName("col2")
    'ここから

    Dim el As IHTMLElement
    For Each el In elList
            Worksheets("Sheet1").Range("A" & exlrow + 1).Value = el.getElementsByTagName("a")(V).href
            exlrow = exlrow + 1
    Next el

    'ここまで

    objIE.Visible = False

Next V

Next i


End Sub

投稿2017/04/20 09:42

編集2017/04/20 11:29