Там нет ошибки, но также нет вывода на Excel после выполнения VBA - PullRequest
Новая
       52

Там нет ошибки, но также нет вывода на Excel после выполнения VBA

0 голосов
/ 28 марта 2020

Это код, который я использую. Нет ошибки в макросе, но нет и вывода на листе 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

1 Ответ

1 голос
/ 28 марта 2020

Таблицы в родительском 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
...