質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

25319閲覧

VBA マクロが途中で止まるバグの解決策について(DoEventsでも解決出来ない)

Susanoo2442

総合スコア153

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2017/05/08 12:07

質問です。
エクセルVBAでスクレイピングツールを開発中なのですが、マクロが途中で止まってしまいます。ループ処理の終わりにDoEvntsを入れたのですが全く解決出来ません。

止まってしまうので、タスクマネージャーでIEを無理やり終了させました。するとエクセルVBA"オートメーションエラーです。リモートプロシージャコールに失敗しました。"とエラーが出てしまいます。

以下エクセルVBAコードです。

Dim Search As String Private Sub CommandButton1_Click() Dim ELInteger2 As Integer Dim ELInteger As Integer Dim ELStringer5 As String Dim ELStringer4 As String Dim ELStringer3 As String Dim ELStringer2 As String Dim ELStringer As String Dim SPDate3 As String Dim SPDate2 As String Dim SPDate As String Dim Colect5 As IHTMLElementCollection Dim Colect4 As IHTMLElementCollection Dim Colect3 As IHTMLElementCollection Dim Colect2 As IHTMLElementCollection Dim Colect As IHTMLElementCollection 'Dim interNet5 As InternetExplorer 'Dim interNet4 As InternetExplorer 'Dim interNet3 As InternetExplorer Dim ChangeExplorer1 As InternetExplorer Dim ChangeExplorer2 As InternetExplorer Dim ChangeExplorer3 As InternetExplorer Dim interNet2 As InternetExplorer Dim interNet As InternetExplorer Dim HTMLD5 As HTMLDocument Dim HTMLD4 As HTMLDocument Dim HTMLD3 As HTMLDocument Dim HTMLD2 As HTMLDocument Dim HTMLD As HTMLDocument Dim Sisokuenzan As String Dim kasan As String Dim ELInteger10 As Integer ELInteger10 = 0 ELIntegerB = 0 ELIntegerC = 0 ELIntegerCount6 = 4 ELIntegerCount5 = 4 ELIntegerCount4 = 4 ELIntegerCount3 = 4 ELIntegerCount2 = 4 ELIntegerCount1 = 4 Dim ELIntegerCountStringer1 As String Dim ELIntegerCountStringer2 As String Dim ELIntegerCountStringer3 As String Dim ELIntegerCountStringer4 As String Dim ELIntegerCountStringer5 As String Dim ELIntegerCountStringer6 As String Dim ELIntegerM As Integer ELIntegerM = 4 Dim ELIntegerM2 As Integer ELIntegerM2 = 4 Dim ELIntegerM3 As Integer ELIntegerM3 = 4 Dim ELStringerM As String Dim ELStringerM2 As String Dim ELStringerM3 As String 'ブランド検索処理(メインルーチンA) Set interNet2 = CreateObject("internetexplorer.Application") interNet2.Visible = False kasan = ".html" Sisokuenzan = Search + kasan interNet2.navigate "http://www.buyma.com/brand/" & Sisokuenzan Do While interNet2.Busy = True Or interNet2.readyState < READYSTATE_COMPLETE DoEvents Loop 'バイヤーランキング抽出処理(メインルーチンB) Set HTMLD = interNet2.document Set Colect = HTMLD.getElementsByClassName("vmimg_120") 'バイヤーランキング抽出処理1(サブルーチンB-1) For Each EL In Colect SPDate = EL.innerHTML ELStringer = Mid(SPDate, 95) ELInteger = InStr(ELStringer, "l") ELStringer2 = Left(ELStringer, ELInteger) 'バイヤーランキング抽出処理2(サブルーチンB-2) Set interNet3 = CreateObject("Internetexplorer.Application") interNet3.Visible = False interNet3.navigate ELStringer2 Debug.Print ELStringer2 Do While interNet3.Busy = True Or interNet3.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD2 = interNet3.document Set Colect2 = HTMLD2.getElementsByClassName("profimg_wrap") 'バイヤーランキング抽出処理3(サブルーチンB-3) For Each El2 In Colect2 SPDate2 = El2.innerHTML ELStringer3 = Mid(SPDate2, 14) ELInteger2 = InStr(ELStringer3, "http") ELInteger4 = ELInteger2 ELStringer4 = Left(ELStringer3, ELInteger4) ELIntegerA = InStr(ELStringer4, "alt") + 5 ELInteger6 = InStr(ELIntegerA, ELStringer4, """") ELInteger8 = ELInteger6 - ELIntegerA ELStringer5 = Mid(ELStringer4, ELIntegerA, ELInteger8) DoEvents Next El2 'バイヤーランキング最終抽出処理(サブルーチンB-4) ELInteger10 = ELInteger10 + 1 If ELInteger10 = 1 Then Range("A1").Value = "ランキング1位:" & ELStringer5 Debug.Print ELStringer5 ElseIf ELInteger10 = 2 Then Range("D1").Value = "ランキング2位:" & ELStringer5 Debug.Print ELStringer5 ElseIf ELInteger10 = 3 Then Range("G1").Value = "ランキング3位:" & ELStringer5 Debug.Print ELStringer5 End If 'バイヤー販売リスト処理(メインルーチンC) ELInteger12 = InStr(ELStringer4, ".html") - 1 ELStringer13 = Left(ELStringer4, ELInteger12) Set interNet4 = CreateObject("Internetexplorer.Application") interNet4.Visible = False interNet4.navigate "http://www.buyma.com/" & ELStringer13 + "/sales_1.html" Do While interNet4.Busy = True Or interNet4.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD3 = interNet4.document Set Colect3 = HTMLD3.getElementsByClassName("data_line0") 'Set HTMLD4 = interNet4.document 'Set Colect4 = HTMLD4.getElementsByClassName("data_line1") '商品リスト抽出処理1(サブルーチンC-4) ELIntegerB = ELIntegerB + 1 If ELIntegerB = 1 Then For Each El3 In Colect3 ELIntegerCount1 = ELIntegerCount1 + 1 ELIntegerCountStringer1 = ELIntegerCount1 SPDate10 = El3.innerText Range("A" & ELIntegerCountStringer1).Value = SPDate10 DoEvents Next El3 End If '金額抽出処理1(サブルーチンC-1) ELIntegerC = ELIntegerC + 1 If ELIntegerC = 1 Then For Each ELD In Colect3 ELStringer15 = ELD.innerHTML ELStringer17 = Mid(ELStringer15, 168) ELInteger18 = InStr(ELStringer17, """>") ELStringer20 = Left(ELStringer17, ELInteger18) ELInteger100 = Len(ELStringer20) ELInteger200 = ELInteger100 - 2 ELStringer24 = Left(ELStringer20, ELInteger200) ELInteger2000 = Len(ELStringer24) ELInteger4000 = ELInteger2000 - 15 ELStringer1000 = Right(ELStringer24, ELInteger4000) Debug.Print ELStringer1000 Set interNet5 = CreateObject("Internetexplorer.Application") interNet5.Visible = False interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000 Do While interNet5.Busy = True Or interNet5.readyState < READYSTATE_COMPLETE '↑エラーの原因はココ DoEvents Loop Set HTMLD5 = interNet5.document Set Colect5 = HTMLD5.getElementsByClassName("price_txt") For Each ELP In Colect5 ELIntegerM = ELIntegerM + 1 ELStringerM = ELIntegerM Range("B" & ELStringerM).Value = ELP.innerText interNet5.Quit Set interNet5 = Nothing DoEvents Next ELP DoEvents Next ELD End If '商品リスト抽出処理2(サブルーチンC-5) If ELIntegerB = 2 Then For Each El4 In Colect3 ELIntegerCount2 = ELIntegerCount2 + 1 ELIntegerCountStringer2 = ELIntegerCount2 SPDate10 = El4.innerText Range("C" & ELIntegerCountStringer2).Value = SPDate10 DoEvents Next El4 End If '金額抽出処理2(サブルーチンC-2) If ELIntegerC = 2 Then For Each ELD In Colect3 ELStringer15 = ELD.innerHTML ELStringer17 = Mid(ELStringer15, 168) ELInteger18 = InStr(ELStringer17, """>") ELStringer20 = Left(ELStringer17, ELInteger18) ELInteger100 = Len(ELStringer20) ELInteger200 = ELInteger100 - 2 ELStringer24 = Left(ELStringer20, ELInteger200) ELInteger2000 = Len(ELStringer24) ELInteger4000 = ELInteger2000 - 15 ELStringer1000 = Right(ELStringer24, ELInteger4000) Set interNet5 = CreateObject("Internetexplorer.Application") interNet5.Visible = False interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000 Do While interNet5.Busy = True Or interNet5.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD5 = interNet5.document Set Colect5 = HTMLD5.getElementsByClassName("price_txt") For Each ELP In Colect5 ELIntegerM2 = ELIntegerM2 + 1 ELStringerM2 = ELIntegerM2 Range("D" & ELStringerM2).Value = ELP.innerText interNet5.Quit Set interNet5 = Nothing DoEvents Next ELP DoEvents Next ELD End If '商品リスト抽出処理3(サブルーチンC-6) If ELIntegerB = 3 Then For Each El5 In Colect3 ELIntegerCount3 = ELIntegerCount3 + 1 ELIntegerCountStringer3 = ELIntegerCount3 SPDate10 = El5.innerText Range("E" & ELIntegerCountStringer3).Value = SPDate10 DoEvents Next El5 End If '金額抽出処理3(サブルーチンC-3) If ELIntegerC = 3 Then For Each ELD In Colect3 ELStringer15 = ELD.innerHTML ELStringer17 = Mid(ELStringer15, 168) ELInteger18 = InStr(ELStringer17, """>") ELStringer20 = Left(ELStringer17, ELInteger18) ELInteger100 = Len(ELStringer20) ELInteger200 = ELInteger100 - 2 ELStringer24 = Left(ELStringer20, ELInteger200) ELInteger2000 = Len(ELStringer24) ELInteger4000 = ELInteger2000 - 15 ELStringer1000 = Right(ELStringer24, ELInteger4000) Set interNet5 = CreateObject("Internetexplorer.Application") interNet5.Visible = False interNet5.navigate "http://www.buyma.com/item/" & ELStringer1000 Do While interNet5.Busy = True Or interNet5.readyState < READYSTATE_COMPLETE DoEvents Loop Set HTMLD5 = interNet5.document Set Colect5 = HTMLD5.getElementsByClassName("price_txt") For Each ELP In Colect5 ELIntegerM3 = ELIntegerM3 + 1 ELStringerM3 = ELIntegerM3 Range("F" & ELStringerM3).Value = ELP.innerText interNet5.Quit Set interNet5 = Nothing DoEvents Next ELP DoEvents Next ELD End If '商品リスト抽出処理4(サブルーチンC-7) 'ELIntegerC = ELIntegerC + 1 'If ELIntegerC = 1 Then 'For Each El6 In Colect4 'ELIntegerCount4 = ELIntegerCount4 + 1 'ELIntegerCountStringer4 = ELIntegerCount4 'SPDate11 = El6.innerText 'Range("Z" & ELIntegerCountStringer4).Value = SPDate11 'Next El6 ' '商品リスト抽出処理5(サブルーチンC-8) 'ElseIf ELIntegerC = 2 Then 'For Each El7 In Colect4 'ELIntegerCount5 = ELIntegerCount5 + 1 'ELIntegerCountStringer5 = ELIntegerCount5 'SPDate11 = El7.innerText 'Range("Y" & ELIntegerCountStringer5).Value = SPDate11 'Next El7 ' ''商品リスト抽出処理6(サブルーチンC-9) 'ElseIf ELIntegerC = 3 Then 'For Each El8 In Colect4 'ELIntegerCount6 = ELIntegerCount6 + 1 'ELIntegerCountStringer6 = ELIntegerCount6 'SPDate11 = El8.innerText 'Range("X" & ELIntegerCountStringer6).Value = SPDate11 'Next El8 'End If interNet3.Quit Set interNet3 = Nothing interNet4.Quit Set interNet4 = Nothing DoEvents Next EL interNet2.Quit Set interNet2 = Nothing End Sub 'スクレイピング開始処理 Private Sub CommandButton2_Click() End Sub 'バイヤーリスト抽出処理 Private Sub CommandButton3_Click() End Sub Private Sub TextBox1_Change() Search = TextBox1.Value End Sub Private Sub UserForm_Click() End Sub

グーグルでエラー原因を検索しながら、トライアンドエラーを繰り返しましたが結局原因が分かりませんでした。

詳しい方、対処方法をご教示して頂ければと存じます。
宜しくお願い致します。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

原因はわかりませんが、当方の環境で実行した限りでは、時間はかかりましたが最後まで実行できました(Excel2010)
Searchには"_ADIDAS-アディダス"を設定しました。
実行中、ツールバーの一時停止も停止も押せるので、DoEventsはきちんと効いているようです。
止まってしまうというのは、上記のように一時停止も停止もできないのでしょうか?
単に時間がかかっているだけということは?

投稿2017/05/09 01:28

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Susanoo2442

2017/05/09 06:20

ご回答ありがとうございます。止まってしまうとの事でしたが、具体的にはプログラム自体が進行しなくなる状態を指させて頂いたつもりでした。最終的にReadyStateの返り値をLOADEDに指定すると、プログラムが再度進行する様になりました。しかしながら、落ち目の無い点としましては、ゴールデンウィークに入る前に一度、プログラムを実行していたのですが、その際は、ReadyStateのCOMPLET_STATEという返り値でも動いていました。それが、GW明けにプログラムを実行してみると、今回質問させて頂いた様に、上記の返り値では、動かなくなっておりました。やはり、ttyp様が仰られた通り、単に時間がかかって頂けなのかもしれません。IEは回線や接続状況等によって速度がマチマチですので、もう少し、慎重にロジックを考えながらコードを書いて行きたいと思います。ありがとうございました!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問