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

回答

相关问题