2016-07-14 6 views
0

私は、vitals.comから医者のレビューを引き出し、Excelシートに入れるスクリプトを作成しようとしています。 レビューを引っ張ったときにうまくいきましたが、日付を追加するために追加したときに最初のレビューと日付が印刷され、しばらくしてからクラッシュします。私はこれのすべてに新しいので、私は見ていないいくつかの目障りな間違いがあることを望んでいる。私はそれを修正する方法を見つけることができないようです。どんな助けでも大歓迎です。VBAでWebから情報を引き出してExcelに配置する

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim DocCounter As Integer 
    DocCounter = 2 
    Dim Go As String 
    Go = "Go" 

    If IsEmpty(Cells(1, 4)) And Cells(1, 3).Value = Go Then 

    If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo EmptySheet 
    Do 

     Dim Reviews As String 
     Reviews = "/reviews" 

     Dim IE As MSXML2.XMLHTTP60 
     Set IE = New MSXML2.XMLHTTP60 

     Application.Wait (Now + TimeValue("0:00:01")) 
     IE.Open "get", "http://vitals.com/doctors/" & Cells(DocCounter, 1).Value & Reviews, True 
     IE.send 

     While IE.readyState <> 4 
     DoEvents 
     Wend 

     Application.Wait (Now + TimeValue("0:00:01")) 

     Dim HTMLDoc As MSHTML.HTMLDocument 
     Dim HTMLBody As MSHTML.HTMLBody 
     Set HTMLDoc = New MSHTML.HTMLDocument 
     Set HTMLBody = HTMLDoc.body 
     HTMLBody.innerHTML = IE.responseText 

     Dim ReviewCounterString As String 
     Dim ReviewCounter As Integer 
     ReviewCounterString = HTMLDoc.getElementsByName("overall_total_reviews")(0).getElementsByTagName("h3")(0).innerText 
     ReviewCounter = CInt(ReviewCounterString) 

     'Pull info from website loop' 
     Dim RC As Integer 
     RC = 2 

     Dim sDD As String 
     Dim WebCounter As Integer 
     WebCounter = 0 

     Do 
      sDD = HTMLDoc.getElementsByClassName("date c_date dtreviewed")(WebCounter).innerText & "-" & HTMLDoc.getElementsByClassName("description")(WebCounter).innerText 
      Cells(DocCounter, RC).Value = sDD 
      WebCounter = WebCounter + 1 
      RC = RC + 1 
      Application.Wait (Now + TimeValue("0:00:01")) 
     Loop Until WebCounter = ReviewCounter 

     Application.Wait (Now + TimeValue("0:00:01")) 
     DocCounter = DocCounter + 1 
     If IsEmpty(Cells(DocCounter, 1).Value) Then GoTo Finished 

    Loop 

Finished: 
    MsgBox ("Complete") 
    End Sub 

EmptySheet: 
    MsgBox ("The Excel Sheet is Empty. Please add Doctors.") 
    End Sub 

    End If 
End Sub 
+0

"...そしてクラッシュする" - エラーはありますか?もしそうなら、どの行でどのようなエラー? – BruceWayne

+0

いいえ、そうではありません。 Excelがフリーズしてクラッシュします。私は間違いがない。申し訳ありませんが、これは愚かな質問ですが、私がExcelを再オープンした後にエラーがあった場合に私が見つけることができる方法はありますか? – MattMicko

+2

(ブレークポイントを介して)ステップバイステップで行くか、ループの値が増加するいくつかのポイントで 'Debug.Print'を使用してください...そして、マクロが実行されている間に出力をチェックしてください...また、' DoEvents'を内部でフリーズするのを避けるために 'Do ... Loop Until WebCounter = ReviewCounter'ループを実行します。これは'> = '' '' '' '' ReviewCounter'が '0'ならばあなたのExcelはフリーズしますケースはこちら) –

答えて

0

あなたはWorksheet.Changeイベントが再度トリガますCells(DocCounter, RC).Value = sDDを行うと、コールスタックがいっぱいになるまでマクロは、何度も繰り返し起動すると(と思います)。

は終わり

マクロの開始時に
Application.EnableEvents = False 

Application.EnableEvents = True 

を追加します。このようにして、イベントはマクロ中にトリガされません。

編集:シート上の任意の場所が変更されるたびにマクロを実行することが本当に必要かどうかを考える必要があります。 Target(変更された範囲)をチェックして、変更によりデータをリロードする必要があるかどうかを確認することができます。

+0

パーフェクト!ありがとうございました!その実行はスムーズに今! – MattMicko

+0

@MattMicko私は少しポストに何かを加えました。シート上の何かを変更するたびにデータを再読み込みする必要がありますか? – arcadeprecinct

+0

ありがとう!代わりにボタンを追加して、クリックするとレビューを更新します。 – MattMicko

関連する問題