私は、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
"...そしてクラッシュする" - エラーはありますか?もしそうなら、どの行でどのようなエラー? – BruceWayne
いいえ、そうではありません。 Excelがフリーズしてクラッシュします。私は間違いがない。申し訳ありませんが、これは愚かな質問ですが、私がExcelを再オープンした後にエラーがあった場合に私が見つけることができる方法はありますか? – MattMicko
(ブレークポイントを介して)ステップバイステップで行くか、ループの値が増加するいくつかのポイントで 'Debug.Print'を使用してください...そして、マクロが実行されている間に出力をチェックしてください...また、' DoEvents'を内部でフリーズするのを避けるために 'Do ... Loop Until WebCounter = ReviewCounter'ループを実行します。これは'> = '' '' '' '' ReviewCounter'が '0'ならばあなたのExcelはフリーズしますケースはこちら) –