0

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

导航循环没有问题，它可以正确循环所有元素并正确扩展细节。

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

我 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
4

2 回答 2

1

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

所以你确定你没有在第二张纸上写任何东西 - 或者你只是在第 100 行写什么？

我相信如果您包含以下声明，它可能会起作用

ActRw = 0

在你说的那一行之后

Dim ActRw  As Long

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

于 2017-07-21T10:24:05.243 回答
0

你能在第二个循环中移动这段代码吗？

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

还要确保在循环结束时重命名此工作表，以避免工作表名称重复

于 2017-07-21T09:44:41.907 回答