没有错误,但在VBA执行后excel上也没有输出

没有错误,但在VBA执行后excel上也没有输出,excel,vba,import-from-excel,Excel,Vba,Import From Excel,这是我正在使用的代码。宏上没有错误,但excel工作表上也没有输出。 我正试图从表中获取所有股票的数据 Sub sqylogin() On Error Resume Next Dim ie, objShell, Wnd As Object Set objShell = CreateObject("Shell.Application") Application.Calculation = xlManual ieopen = True For Each Wnd In objShell.Windows

这是我正在使用的代码。宏上没有错误,但excel工作表上也没有输出。 我正试图从表中获取所有股票的数据

Sub sqylogin()
On Error Resume Next
Dim ie, objShell, Wnd As Object
Set objShell = CreateObject("Shell.Application")
Application.Calculation = xlManual
ieopen = True
For Each Wnd In objShell.Windows
  If Right(Wnd.Name, 17) = "Internet Explorer" Then
    Set ie = Wnd
    ieopen = False
    Exit For
  End If
Next Wnd
If ieopen Then Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

p = "https://www.pse.com.ph/stockMarket/marketInfo-marketActivity.html?tab=1&indexName=All%20Shares"
ie.navigate (p): Application.Wait (Now + #12:00:59 AM#)

Set divelements = ie.Document.getElementsbytagname("div")
Cells(1, 1) = Now: c = 2
For Each divelement In divelements
 If divelement.ID = "ext-gen291" Then
   For j = 0 To 300
    For i = 0 To 8
     Cells(c + j, i + 1).Value = divelement.Children(j).Children(0).Children(0).Children(0).Children(i).innertext
    Next i
   Next j
 End If
Next divelement

Set ie = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

父div中的表是通过ajax调用动态加载的,因此需要某种等待条件来确保它们存在。我根据存在的子表的数量显示等待条件,并使用剪贴板将子表复制粘贴到工作表中

Option Explicit

Public Sub GetMarketActivity()

    Dim ie As SHDocVw.InternetExplorer, clipboard As Object

    Set ie = New SHDocVw.InternetExplorer
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    Dim t As Date
    Const MAX_WAIT_SEC As Long = 360

    With ie
        .Visible = True
        .Navigate2 "https://www.pse.com.ph/stockMarket/marketInfo-marketActivity.html?tab=1&indexName=All%20Shares"

        Do
            DoEvents
        Loop While .Busy Or .readyState <> READYSTATE_COMPLETE

        t = Timer
        Do
            DoEvents
            If Timer - t > MAX_WAIT_SEC Then Exit Sub
        Loop Until .document.querySelectorAll(".x-grid3-row-table").Length > 1 '<wait for more than one record (Table)

        Dim tables As Object, i As Long, headers()

        Set tables = .document.querySelectorAll(".x-grid3-row-table")
        headers = Array("Record", "Symbol", "Last trade date", "Last trade price", "Outstanding shares")

       For i = 0 To tables.Length - 1

            clipboard.SetText tables.item(i).outerHTML
            clipboard.PutInClipboard
            With ActiveSheet
                .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
                .Cells(i + 2, 1).PasteSpecial
            End With
        Next
        .Quit
    End With
End Sub

删除错误继续下一步,再试一次Hi QHarr,我尝试了你的代码它正在工作,尽管在粘贴10-20行后我遇到了一个错误。范围类的特殊方法失败。谢谢。嗨,恐怕我在测试中运行得很好,所以我会看看今晚是否可以复制。