現在、スクレイピングを下記コードで回しているのですが下記ループを3周したあたりで止まってしまいます。
調べたところdo eventが重いみたいな情報があり、
sleep 1000など加えたのですが変わらず止まってしまいます。
お手数をおかけいたしますが知見をいただけますと幸いです。
※URLやサイトのclass名などは変更しています。
For i = 1 To 30
On Error Resume Next
Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット 'URLを取得 objIE.Visible = True 'IEを表示 objIE.navigate "https://example.com/page=" & i & "test" 'IEでURLを開く Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち DoEvents Loop Sleep 1000
vba
1 2 3Sub listPost() 4 5Dim objIE As InternetExplorer 'IEオブジェクトを準備 6 7For i = 1 To 30 8On Error Resume Next 9 10 Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット 11 12 'URLを取得 13 objIE.Visible = True 'IEを表示 14 objIE.navigate "https://example.com/page=" & i & "test" 'IEでURLを開く 15 16 17 Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち 18 19 DoEvents 20 21 Loop 22 Sleep 1000 23 24 Dim htmlDocURL As HTMLDocument 'HTMLドキュメントオブジェクトを準備 25 Set htmlDocURL = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット 26 27 Dim elList As IHTMLElementCollection 28 Set elList = htmlDocURL.getElementsByClassName("list") 'class="buttonArea"のdiv要素を掴む 29 30 31 'ここから 32 33 Dim el As IHTMLElement 34 For Each el In elList 35 For t = 0 To 19 36 Worksheets("Sheet1").Range("A" & exlrow + 1).Value = el.getElementsByClassName("detail")(t).getElementsByTagName("h3")(0).innerText 37 Worksheets("Sheet1").Range("B" & exlrow + 1).Value = el.getElementsByClassName("detail")(t).getElementsByClassName("cell")(0).outerText 38 Worksheets("Sheet1").Range("C" & exlrow + 1).Value = el.getElementsByClassName("detail")(t).getElementsByClassName("cell")(1).innerText 39 Worksheets("Sheet1").Range("D" & exlrow + 1).Value = el.getElementsByClassName("detail")(t).getElementsByClassName("cell")(2).innerText 40 Worksheets("Sheet1").Range("E" & exlrow + 1).Value = el.getElementsByClassName("detail")(t).getElementsByTagName("a")(0).href 41 42 exlrow = exlrow + 1 43 Next t 44 Next el 45 46 'ここまで 47 48 objIE.Visible = False 49 objIE.Quit 50Next i 51 52 53 54exlrow = 14000 55'ページ情報を取得 56For j = 1 To exlrow 57 Set objIE = CreateObject("Internetexplorer.Application") '新しいIEオブジェクトを作成してセット 58 objIE.Visible = True 'IEを表示 59 objIE.navigate Worksheets("Sheet1").Range("E" & j).Value 'IEでURLを開く 60 On Error Resume Next 61 62 Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE '読み込み待ち 63 64 DoEvents 65 66 Loop 67 Sleep 1000 68 69 Dim htmlDocCompanies As HTMLDocument 'HTMLドキュメントオブジェクトを準備 70 Set htmlDocCompanies = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット 71 72 Dim CoList As IHTMLElementCollection 73 Set CoList = htmlDocURL.getElementsByClassName("column") 'class="descArticleUnit dataCompanyInfoSummary"のdiv要素を掴む 74 75 76 Dim elnumber As String 77 Dim elperson As String 78 Dim elcapital As String 79 Dim elemployee As String 80 Dim elstart As String 81 82 elnumber = "" 83 elperson = "" 84 elcapital = "" 85 elemployee = "" 86 elstart = "" 87 On Error Resume Next 88 89 For k = 0 To 9 90 91 92 If htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("key")(0).innerText = "企業名" Then 93 94 95 elnumber = htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("value")(0).innerText 96 97 End If 98 99 If htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("key")(0).innerText = "代表者名" Then 100 101 elperson = htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("value")(0).innerText 102 103 End If 104 105 106 If htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("key")(0).innerText = "売上" Then 107 108 elcapital = htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("value")(0).innerText 109 110 End If 111 112 If htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("key")(0).innerText = "フリガナ" Then 113 114 elemployee = htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("value")(0).innerText 115 116 End If 117 118 If htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("key")(0).innerText = "設立年月" Then 119 120 elstart = htmlDocCompanies.getElementsByClassName("info")(0).getElementsByClassName("a-company-info")(k).getElementsByClassName("value")(0).innerText 121 122 End If 123 124 Next k 125 126 Worksheets("Sheet1").Cells(j, 6).Value = elnumber 127 Worksheets("Sheet1").Cells(j, 7).Value = elperson 128 Worksheets("Sheet1").Cells(j, 8).Value = elcapital 129 Worksheets("Sheet1").Cells(j, 9).Value = elemployee 130 Worksheets("Sheet1").Cells(j, 10).Value = elstart 131 132 133 objIE.Visible = False 134 objIE.Quit 135Next j 136 137End Sub 138 139
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/05/29 11:23