Question

我已经尝试运行此代码并且它会收到一个对象错误，因为我已经在10秒到5分钟的等待时间内输入了循环启动。当我调试时，我得到的输出结果很好，但是我必须手动完成这些工作以使其工作 - 这需要一段时间来处理大型数据集。

我尝试了一个小数据，让这个城市成为阿拉斯加州。＆＃34;反正有没有我手动调试它使这个代码工作？因为老实说，我不知道它为什么不起作用。非常感谢提前。

Formula

使用Sleeper API更新了代码（仍无效）

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

更新代码2016年6月6日（归功于@pcw＆amp; @dbmitch）

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

帮助创建动态按钮以按下以开始搜索按下

Answer 1

好的 - 我打算编辑最后一个答案，但是等待，准备状态和忙碌的检查都无法正常工作。我确实检查了添加一个WithEvents来检查实际的文档完成情况，但这对你的情况不起作用。页面网址永远不会随按钮点击而变化。所以试试这个

我只是确保您尝试加载的元素在尝试使用之前确实存在。

警告 - 如果元素永远不会出现，这可能会导致无限循环。理想情况下，您需要添加一个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

Answer 2

我认为你正朝着正确的方向前进。问题是文档还没有完全呈现。理想的解决方案应该是在导航之前添加一个设置为false的全局布尔变量“docComplete”，并在触发该事件并且目标URL与您的导航URL匹配时为true。

但是这个更简单的解决方案现在可能有效

在此之前

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

VBA Application.Wait对象错误

2 个答案: