VBA問題從網絡上拉取信息並將其放入Excel

我正在嘗試編寫一個腳本，以便將來自vitals.com的醫生評論放入Excel表格中。當我只是拉取評論時，它運行良好，但是當我添加它以拉取日期時，它會打印第一個評論和日期，然後加載一段時間，然後崩潰。我對所有這些都是陌生的，所以我希望有一些明顯的錯誤我沒有看到。我似乎無法找到解決問題的方法。任何幫助將不勝感激。VBA問題從網絡上拉取信息並將其放入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

來源

2016-07-14 MattMicko

「...然後崩潰」 - 它會給出任何錯誤嗎？如果是這樣，哪一行發生什麼錯誤？ – BruceWayne

不，它不。 Excel只是凍結，然後崩潰。我沒有收到錯誤。對不起，如果這是一個愚蠢的問題，但有沒有一種方法，我可以找到我重新打開excel後是否有錯誤？ – MattMicko

或者一步一步地（通過斷點）或者在幾個點上使用'Debug.Print'來增加循環值......然後在宏運行時檢查輸出......我還建議在內部執行一個DoEvents 'Do ...循環直到WebCounter = ReviewCounter'循環避免凍結，這也應該是'> ='而不是簡單的'='...如果ReviewCounter是'0'，你的excel將凍結（我建議這裏的情況） –

當你做Cells(DocCounter, RC).Value = sDD的Worksheet.Change事件被再次觸發和宏再次重新開始，直到調用堆棧滿（我認爲）。

在宏觀的開始和

Application.EnableEvents = True

末添加

Application.EnableEvents = False

。這樣的事件將不會在宏觀期間被觸發。

編輯：您應該也許應該考慮一下，如果每次在工作表的任何地方更改任何內容時，是否真的有必要運行宏。您可以先檢查Target（已更改的範圍），以查看更改是否需要重新加載數據。

來源

2016-07-14 18:00:38 arcadeprecinct

完美！謝謝！它現在順利運行！ – MattMicko

@MattMicko我在帖子中添加了一些內容。您是否確定每次在表格上更改某些內容時都需要重新加載數據？ – arcadeprecinct

謝謝！我添加了一個按鈕，因此它會在點擊它時更新評論。 – MattMicko

VBA問題從網絡上拉取信息並將其放入Excel

回答

相關問題