VBA Application.Wait对象错误 [英] VBA Application.Wait Object Error

查看：236
本文介绍了VBA Application.Wait对象错误的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我已经尝试运行这个代码，它会得到一个对象错误，因为我已经输入了循环开始的等待时间的10秒到5分钟之间的任何地方。当我调试时，我得到的结果输出得很好，但我必须手动通过这些情况使其工作 - 这需要一些大的数据集。

I've tried running this code and it gets an object error, given that I have inputted anywhere between 10 seconds to 5 minutes of wait time for the loops to start. When I'm debugging, I get the results outputted just fine, but I have to go through the cases manually to make it work -- which takes awhile for a large data set.

我尝试了一个小数据，让城市成为阿拉斯加。有没有办法使这个代码工作没有我手动调试它？因为我真的不知道为什么它不工作。非常感谢提前。

I tried with a small data, by having the city be "alaska." Is there anyway to make this code work without me manually debugging it? Because I honestly don't know why it's not working. Thanks so much in advance. 

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



Updated Code w/ Sleeper API (still not working)

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）

UPDATED CODE 6/6/2016 (credit to @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

帮助创建一个动态按钮来开始搜索按钮

Help with creating a dynamic button to press to start the search press

推荐答案

好的 - 我要修改最后一个答案，但是等待和补充和忙碌的检查才不会奏效。我没有检查添加一个WithEvents来检查实际的文档完​​成，但这不会适用于你的情况。页面网址从不更改按钮点击。所以尝试这样做

Okay - I was going to edit last answer, but the waits and readystates and busy checks were just not going to work. I did check into adding a WithEvents for checking actual document completion, but that wouldn't work for your case. The page url never changes with the button clicks. So try this instead

我只是确定您尝试加载的元素实际上是在尝试使用它们之前。

I just make sure the elements you're trying to load are actually there before trying to use them.

警告 - 如果元素从不出现，这可能会导致无限循环。理想情况下，您可以添加一个MAXIMUM_TIME常量，并循环播放已经过去的秒数。

Warning - this could lead to an infinite loop if the elements never appear. Ideally you'd add a MAXIMUM_TIME constant and a loop for number of seconds that has elapsed.

我还更改了您的Application.Wait代码使用Sleep WIn32 API - 因为我不知道你正在使用什么应用程序。您可以将此声明添加到代码的顶部

I also changed your Application.Wait code to use the Sleep WIn32 API - since I wasn't sure what application you were using. You can add this declare to the top of your code

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

这篇关于VBA Application.Wait对象错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
前端开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆