IE-Automation：坚持调试循环的第一个实例正确完成，但循环不会中断

Question

我编写了导航到网站的代码，转到内页展开详细信息，然后将 HTML 表复制到新创建的 sheet。

导航循环没有问题，它可以正确循环遍历所有元素并正确展开详细信息。

复制表格时出现问题。第一次复制表时，第二轮只创建新的 sheet 但不粘贴任何内容。

我 debug.print 变量的内容并且还使用了断点，因此数据在变量中但未粘贴。

如果您需要更多数据，请告诉我。提前致谢！

For Each ele In html.getElementsByTagName("a")
If InStr(1, ele.ID, "cup_cuplv", vbTextCompare) > 0 Then

ele.FireEvent "onclick" ' clicks on an item in the list

PauseTime = 5 ' Set duration in seconds
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop

       ' For Each ele1 In html.getElementsByClassName("icn_vw icn_tgld")

           ' If InStr(1, ele1.innerText, "Details", vbTextCompare) > 0 Then
            Set ele1 = html.getElementsByClassName("icn_vw icn_tgld")(0)

            ele1.FireEvent "onclick" ' clicks to expand details

            Set ele1 = Nothing
            PauseTime = 10 ' Set duration in seconds
            Start = Timer ' Set start time.
            Do While Timer < Start + PauseTime
            DoEvents ' Yield to other processes.
            Loop

                Dim objTable As Object
                Dim lRow   As Long
                Dim lngTable As Long
                Dim lngRow As Long
                Dim lngCol As Long
                Dim ActRw  As Long
                'Set html = New HTMLDocument

                Set NewWS = ThisWorkbook.Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet) 'created new sheet
                Set IE = objShell.Windows(IE_count - 1)
                    Do While IE.Busy: Loop
                       html.body.innerHTML = IE.Document.body.innerHTML
                        With html.body
                            Set objTable = .getElementsByTagName("table")
                            For lngTable = 0 To objTable.Length - 1
                                For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                                    For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                                    Worksheets(NewWS).Activate
                                    NewWS.Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText ' problem here doesnt paste 2nd 3rd and nth time
                                    Next lngCol
                                Next lngRow
                                ActRw = ActRw + objTable(lngTable).Rows.Length + 1
                            Next lngTable

                        End With
                'Set html.body = Nothing
                Set objTable = Nothing
                Set NewWS = Nothing
                'End If

            PauseTime = 3 ' Set duration in seconds
            Start = Timer ' Set start time.
            Do While Timer < Start + PauseTime
            DoEvents ' Yield to other processes.
            Loop
        Debug.Print ele1.ID
        'Next ele1



    Debug.Print ele.ID
html.getElementById("tab_mn2").FireEvent "onclick" ' goes back to main item list
PauseTime = 5 ' Set duration in seconds
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
End If
Next ele ' goes to next item in main list here

Answer 1

你能把这段代码移到第二个循环中吗？

Set NewWS = ThisWorkbook.Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet) 'created new sheet

还要确保在循环结束时重命名此 sheet 以避免重复 sheet 名称

Answer 2

我注意到你从未重置变量 ActRw，这意味着你开始复制到你创建的第一个作品sheet的第 1 行，然后是你创建的第二个作品sheet在第一个 sheet 处完成的行之后的行开始复制。

所以你确定你没有在第二个 sheet 中写任何东西 - 或者你只是在第 100 行或其他地方写它？

我相信如果你包含一个声明

，它可能会起作用

ActRw = 0

在你说的行之后

Dim ActRw  As Long

注意：VBA没有比过程级别更小的变量范围。因此，尽管 VB.Net（可能还有其他语言）会将 Loop 块中的 Dim ActRw As Long 语句解释为每次循环都创建一个新变量，因此每次都将其初始化为零通过循环，VBA 在程序开始时立即创建变量。

IE-Automation：坚持调试循环的第一个实例正确完成，但循环不会中断

IE-Automation: Stuck with debuging only first instance of loop is done correctly, but loop does not break

internet-explorer

vba

ie-automation