VBA Application.Wait对象错误
我已经试过运行这个代码，并得到一个对象的错误，因为我已经input了10秒到5分钟的循环启动等待时间的任何地方。 当我正在debugging时，我得到的结果输出很好，但我必须手动通过案例使其工作 – 这需要一个大型数据集一段时间。
我尝试了一个小数据，让这个城市成为“阿拉斯加”。 反正有没有我手动debugging，使这个代码工作？ 因为我真的不知道为什么它不工作。 非常感谢。
Private Sub CreditUnion() Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, r As Long Dim beginTime As Date, i As Long Set IE = CreateObject("internetexplorer.application") IE.navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx" IE.Visible = False Do While IE.Busy DoEvents Loop 'input city name into form IE.document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value 'click find button IE.document.getelementbyid("MainContent_btnFind").Click Do DoEvents 'wait 5 sec. for screen refresh beginTime = Now Application.Wait (Now + TimeValue("00:05:00")) With IE.document.getelementbyid("MainContent_grid") For r = 1 To .Rows.Length - 1 If Not IsArray(charterInfo) Then ReDim charterInfo(5, 0) As Variant Else ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant End If charterInfo(0, UBound(charterInfo, 2)) = .Rows(r).Cells(0).innertext Next r End With 'check if final page, if not click "next page" page = IE.document.getelementbyid("MainContent_pager_to").innertext If page < IE.document.getelementbyid("MainContent_pager_total").innertext Then IE.document.getelementbyid("MainContent_pageNext").Click Loop Until page = IE.document.getelementbyid("MainContent_pager_total").innertext For r = 0 To UBound(charterInfo, 2) IE.navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r) Do While IE.Busy DoEvents Loop 'wait 5 sec. for screen refresh beginTime = Now Application.Wait beginTime + TimeValue("0:05:00") With IE.document.getelementbyid("MainContent_newDetails") For i = 0 To .Rows.Length - 1 DoEvents Select Case .Rows(i).Cells(0).innertext Case "Credit Union Name:" charterInfo(1, r) = .Rows(i).Cells(1).innertext Case "Region:" charterInfo(2, r) = .Rows(i).Cells(1).innertext Case "Credit Union Status:" charterInfo(3, r) = .Rows(i).Cells(1).innertext Case "Assets:" charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "") Case "Number of Members:" charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "") End Select Next i End With Next r IE.Quit Set IE = Nothing 'post result on Excel cell Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo) End Sub 更新的代码w / Sleeper API（仍然不工作）
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub CreditUnion() Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, r As Long Dim beginTime As Date, i As Long Set IE = CreateObject("internetexplorer.application") With IE.Document.getelementbyid("MainContent_newDetails") With IE strTargetURL = "http://mapping.ncua.gov/ResearchCreditUnion.aspx" .Navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx" .Visible = False While IsNull(.Document.getelementbyid("MainContent_txtCity")) DoEvents Sleep 500 Wend 'input city name into form .Document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value DoEvents Sleep 500 'click find button .Document.getelementbyid("MainContent_btnFind").Click End With Do DoEvents While IsNull(IE.Document.getelementbyid("MainContent_grid")) DoEvents Sleep 1000 Wend For r = 1 To IE.Document.getelementbyid("MainContent_grid").Rows.Length - 1 If Not IsArray(charterInfo) Then ReDim charterInfo(5, 0) As Variant Else ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant End If charterInfo(0, UBound(charterInfo, 2)) = IE.Document.getelementbyid("MainContent_grid").Rows(r).Cells(0).innertext Next r 'check if final page, if not click "next page" page = IE.Document.getelementbyid("MainContent_pager_to").innertext If page < IE.Document.getelementbyid("MainContent_pager_total").innertext Then IE.Document.getelementbyid("MainContent_pageNext").Click Do While IE.Busy DoEvents Sleep 500 Loop While IsNull(IE.Document.getelementbyid("MainContent_pager_total")) DoEvents Sleep 1000 Wend End If Loop Until page = IE.Document.getelementbyid("MainContent_pager_total").innertext For r = 0 To UBound(charterInfo, 2) IE.Navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r) Do While IE.Busy DoEvents Loop While IsNull(IE.Document.getelementbyid("MainContent_newDetails")) DoEvents Sleep 1000 Wend With IE.Document.getelementbyid("MainContent_newDetails") For i = 0 To .Rows.Length - 1 DoEvents Select Case .Rows(i).Cells(0).innertext Case "Credit Union Name:" charterInfo(1, r) = .Rows(i).Cells(1).innertext Case "Region:" charterInfo(2, r) = .Rows(i).Cells(1).innertext Case "Credit Union Status:" charterInfo(3, r) = .Rows(i).Cells(1).innertext Case "Assets:" charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "") Case "Number of Members:" charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "") End Select Next i End With Next r 'IE.Quit 'Set IE = Nothing 'post result on Excel cell Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo) End With End Sub
更新的代码6/6/2016（贷给@pcw＆@dbmitch）
Sub CreditUnion() Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, pageTotal As Long, r As Long Dim beginTime As Date, i As Long Set IE = CreateObject("internetexplorer.application") IE.navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx" IE.Visible = False Do While IE.Busy DoEvents Loop 'input city name into form IE.document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value 'click find button IE.document.getelementbyid("MainContent_btnFind").Click beginTime = Now Application.Wait (Now + TimeValue("00:00:05")) 'total pages pageTotal = IE.document.getelementbyid("MainContent_pager_total").innertext page = 0 Do Until page = pageTotal DoEvents page = IE.document.getelementbyid("MainContent_pager_to").innertext With IE.document.getelementbyid("MainContent_grid") For r = 1 To .Rows.Length - 1 If Not IsArray(charterInfo) Then ReDim charterInfo(5, 0) As Variant Else ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant End If charterInfo(0, UBound(charterInfo, 2)) = .Rows(r).Cells(0).innertext Next r End With If page < pageTotal Then IE.document.getelementbyid("MainContent_pageNext").Click beginTime = Now Application.Wait (Now + TimeValue("00:00:05")) End If Loop For r = 0 To UBound(charterInfo, 2) IE.navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r) Do While IE.Busy DoEvents Loop 'wait 5 sec. for screen refresh beginTime = Now Application.Wait beginTime + TimeValue("0:00:05") With IE.document.getelementbyid("MainContent_newDetails") For i = 0 To .Rows.Length - 1 DoEvents Select Case .Rows(i).Cells(0).innertext Case "Credit Union Name:" charterInfo(1, r) = .Rows(i).Cells(1).innertext Case "Region:" charterInfo(2, r) = .Rows(i).Cells(1).innertext Case "Credit Union Status:" charterInfo(3, r) = .Rows(i).Cells(1).innertext Case "Assets:" charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "") Case "Number of Members:" charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "") End Select Next i End With Next r IE.Quit Set IE = Nothing 'post result on Excel cell Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo) End Sub
帮助创build一个dynamicbutton来按下开始search新闻 
好的 – 我要编辑最后一个答案，但是等待，就绪状态和繁忙的检查都不起作用。 我没有检查添加WithEvents检查实际文档完成，但这不适合你的情况。 页面url不会随着button点击而改变。 所以试试这个
我只是确保你试图加载的元素实际上在尝试使用它们之前。
警告 – 如果元素从不出现，这可能会导致无限循环。 理想情况下，您可以添加一个MAXIMUM_TIME常量和一个以经过秒数为单位的循环。
我也改变了你的Application.Wait代码来使用Sleep WIn32 API – 因为我不确定你使用的是什么应用程序。 您可以将此声明添加到代码的顶部
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
另一个修改的代码是：
With IE strTargetURL = "http://mapping.ncua.gov/ResearchCreditUnion.aspx" .Navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx" .Visible = False While IsNull(.Document.getelementbyid("MainContent_txtCity")) DoEvents Sleep 500 Wend 'input city name into form .Document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value DoEvents Sleep 500 'click find button .Document.getelementbyid("MainContent_btnFind").Click End With Do DoEvents While IsNull(IE.Document.getelementbyid("MainContent_grid")) DoEvents Sleep 1000 Wend For r = 1 To IE.Document.getelementbyid("MainContent_grid").Rows.Length - 1 If Not IsArray(charterInfo) Then ReDim charterInfo(5, 0) As Variant Else ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant End If charterInfo(0, UBound(charterInfo, 2)) = IE.Document.getelementbyid("MainContent_grid").Rows(r).Cells(0).innertext Next r 'check if final page, if not click "next page" page = IE.Document.getelementbyid("MainContent_pager_to").innertext If page < IE.Document.getelementbyid("MainContent_pager_total").innertext Then IE.Document.getelementbyid("MainContent_pageNext").Click Do While IE.Busy DoEvents Sleep 500 Loop While IsNull(IE.Document.getelementbyid("MainContent_pager_total")) DoEvents Sleep 1000 Wend End If Loop Until page = IE.Document.getelementbyid("MainContent_pager_total").innertext For r = 0 To UBound(charterInfo, 2) IE.Navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r) Do While IE.Busy DoEvents Loop While IsNull(IE.Document.getelementbyid("MainContent_newDetails")) DoEvents Sleep 1000 Wend With IE.Document.getelementbyid("MainContent_newDetails") For i = 0 To .Rows.Length - 1 DoEvents Select Case .Rows(i).Cells(0).innertext Case "Credit Union Name:" charterInfo(1, r) = .Rows(i).Cells(1).innertext Case "Region:" charterInfo(2, r) = .Rows(i).Cells(1).innertext Case "Credit Union Status:" charterInfo(3, r) = .Rows(i).Cells(1).innertext Case "Assets:" charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "") Case "Number of Members:" charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "") End Select Next i End With Next r
我想你会走向正确的方向。 问题是文档还没有完全呈现。 理想的解决scheme应该是添加一个全局布尔variables“docComplete”，在浏览之前将其设置为false，一旦该事件触发并且目标URL与您的导航URL匹配，则为true。
但是这个更简单的解决scheme现在可能工作
在这一行之前
With IE.document.getelementbyid("MainContent_newDetails")
更换thls
'wait 5 sec. for screen refresh beginTime = Now Application.Wait beginTime + TimeValue("0:05:00")
有了这个：
Do While IE.ReadyState = 4: beginTime = Now: Application.Wait beginTime + TimeValue("0:00:05"): Loop Do While IE.ReadyState <> 4: beginTime = Now: Application.Wait beginTime + TimeValue("0:00:05"): Loop