Извлечь таблицу из веб-страницы - PullRequest
0 голосов
/ 04 марта 2019

Я собираюсь извлечь таблицу, имеющую как «Дата | Открыть | Высокий | Низкий | Закрыть | Количество акций | Число сделок | Общий оборот | Количество в поставках» на веб-странице "https://www.bseindia.com/markets/equity/EQReports/StockPrcHistori.aspx?expandable=7&scripcode=503100&flag=sp&Submit=G"

Ниже приведены мои коды:

Sub Macro_BSE()


  Application.ScreenUpdating = False

  Dim FileName, Pathname As String

    MP = ActiveWorkbook.Name

    Workbooks.Add
    WB2 = ActiveWorkbook.Name

    Dim IE As New SHDocVw.internetexplorer

    Const MAX_WAIT_SEC As Long = 5
    Dim frm As Variant
    Dim element, submitInput As Variant
    Dim rowCollection, htmlRow As Variant
    Dim rowSubContent, rowSubData As Variant
    Dim anchorRange As Range, cellRng As Range
    Dim start
    Dim A As String
    Dim hTable As HTMLTable
    Dim clipboard As Object

    IE.Visible = True
    IE.navigate "https://www.bseindia.com/markets/equity/EQReports/StockPrcHistori.aspx?expandable=7&scripcode=503100&flag=sp&Submit=G"
    While IE.readyState <> 4: DoEvents: Wend

       Application.Wait (Now + TimeValue("00:00:02"))

    IE.document.querySelector("#ContentPlaceHolder1_rdbDaily").Click

    IE.document.querySelector("[name='ctl00$ContentPlaceHolder1$txtFromDate']").Value = "28/11/2018"
    IE.document.querySelector("[name='ctl00$ContentPlaceHolder1$txtToDate']").Value = "28/12/2018"
    IE.document.querySelector("[name='ctl00$ContentPlaceHolder1$btnSubmit']").Click

    Application.Wait (Now + TimeValue("00:00:10"))

     T = Timer
        Do
            On Error Resume Next
            Set hTable = IE.document.querySelector("#ContentPlaceHolder1_spnStkData table")
            On Error GoTo 0
            If Timer - T > MAX_WAIT_SEC Then Exit Do
        Loop While hTable Is Nothing
        If Not hTable Is Nothing Then
            clipboard.SetText hTable.outerHTML
            clipboard.PutInClipboard
            Workbooks(WB2).Worksheets("Sheet1").Range("A1").PasteSpecial

        End If

End Sub

На данный момент я не могу извлечь эту таблицу. Ранее я был в состоянии извлечь из того же кода

Просьба Предложить изменения

1 Ответ

0 голосов
/ 04 марта 2019

Вы никогда не создаете экземпляр объекта буфера обмена.Сделайте это, прежде чем пытаться вставить в него текст.

Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText hTable.outerHTML
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...