クローラに再帰呼び出しを実行させるにはどうすればよいですか？

Question

VBAでクローラを再帰させることはできますか？私はコードをしようとしましたが、すぐに私のコードの点線のマーク領域内の行を見つけると、 "間違った引数の数または無効なプロパティの割り当て"を示すエラーがスローされます。私はVBAの専門家ではないので、私はそれをすることはできませんが、それが可能な方法を適用するかもしれないと思います。

Sub NEWAPPS() 
Dim http As New MSXML2.XMLHTTP60, html As New HTMLDocument 
Dim Items As Object, Item As Object, Newitem As Object, elem As Object 
Dim Z As String 

With http 
    .Open "GET", "https://itunes.apple.com/us/app/candy-crush-saga/id553834731?mt=8", False 
    .send 
    html.body.innerHTML = .responseText 
End With 

Set Items = html.getElementsByClassName("left") 
Set Newitem = html.getElementsByClassName("name") 
    For Each Item In Items 
     x = x + 1 
     If Item.getElementsByTagName("h1").Length Then _ 
     Cells(x, 1) = Item.getElementsByTagName("h1")(0).innerText 

     If Item.getElementsByTagName("h2").Length Then _ 
     Cells(x, 2) = Item.getElementsByTagName("h2")(0).innerText 
    Next Item 

    For Each elem In Newitem 
     Z = elem.href 
    '--------------------- 
     NEWAPPS (Z) 
    '--------------------- 
    Next elem 
End Sub 

Answer 1

再帰サブを作成し、別のサブから呼び出すことができます。しかし、あなたは巨大なソースでなければならないし、長い時間がかかるので、iTunesのアプリをscarpingしています。

同じURLを訪問して悪質なサークルを避けるには、辞書を使用し、探している値がExcelと同様にセルに保存されます。

ここでは、開始するための作業コードを示します。いつ、どのようにして停止する必要があるかによって、コードを変更することができます。

Public dict As Object 

Sub NEWAPPS(Z As String) 
Dim http As New MSXML2.XMLHTTP60, html As New HTMLDocument 
Dim Items As Object, Item As Object, Newitem As Object, elem As Object 

With http 
    .Open "GET", Z, False 
    .send 
    html.body.innerHTML = .responseText 
End With 

Set Newitem = html.getElementsByClassName("name") 
Set Items = html.getElementsByClassName("left") 

If Not dict.Exists(Z) Then 
    dict(Z) = Items(1).innerText 'key is url and value is app name and developer 
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Z 'url 
    Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Split(Items(1).innerText, vbLf)(0) 'app name 
    Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Split(Items(1).innerText, vbLf)(1) 'developer 
End If 

For Each elem In Newitem 
    If Not dict.Exists(elem.href) Then 'skip visiting same urls and avoid vicious circle 
     NEWAPPS (elem.href) 
    End If 
Next elem 
End Sub 

Sub RecursiveCrawler() 
Set dict = CreateObject("Scripting.Dictionary") 
NEWAPPS ("https://itunes.apple.com/us/app/toy-blast/id890378044?mt=8") 
'###You can get stored keys and values once the scraping is finished. If it ever finishes:)### 
'Dim key As Variant 
'For Each key In dict.Keys 
' Debug.Print key 'url 
' Debug.Print Split(dict(key), vbLf)(0) 'app name 
' Debug.Print Split(dict(key), vbLf)(0) 'developer 
'Next key 
End Sub