Веб-парсинг IE Метод NAVIGATE работает по сравнению с MSXML2.XMLHTTP60 не работает - PullRequest
1 голос
/ 08 мая 2020

Я извлекаю данные с сайта NSE, URL-адрес: https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#

Screen shot

Я успешно извлекаю элемент с использованием Inte rnet explorer. Как бы то ни было, этот метод работает медленно, поэтому я перешел на метод MSXML2.XMLHTTP60, но этот метод возвращает пустую строку

, пожалуйста, найдите мои коды

Method 1:Works fine
Sub OI_Slow_Method()
Dim ie As New InternetExplorer
Set ie = CreateObject("InternetExplorer.Application")

Dim Link As String
Link = ActiveSheet.Range("C4").Value

ie.Visible = False
ie.navigate Link
Do

DoEvents
Loop Until ie.readyState = READYSTATE_COMPLETE

Dim doc As HTMLDocument
Set doc = ie.document

Dim objElement As HTMLObjectElement
Dim sDD As String

doc.Focus

ActiveSheet.Cells(1, 1).Value = doc.getElementById("openInterest").innerText 'Open Interest Value


ie.Quit
ie.Visible = True
Set doc = Nothing
Set ie = Nothing
End Sub
'--------------------------

Method 2:Help required in this method only
Sub OI_Fast_Method()
    Dim xhr As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument

    Set xhr = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument

    With xhr
        .Open "GET", "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=30APR2020#", False
        .send
         html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

  Debug.Print html.getElementById("openInterest").Innertext 
  'The output of this is "<SPAN id=openInterest>??</SPAN>" only question mark returned inside the SPAN
End Sub

1 Ответ

0 голосов
/ 12 мая 2020

Думаю, Тим, как всегда, попал в самую точку. Вы получаете необработанный XML, а то, что вам нужно, отсутствует в этом XML. Вы можете сделать дамп данных и получить то, что хотите.

Sub DumpData()

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

URL = "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#"

'Wait for site to fully load
ie.Navigate2 URL
Do While ie.Busy = True
   DoEvents
Loop

RowCount = 1

With Sheets("Sheet1")
   .Cells.ClearContents
   RowCount = 1
   For Each itm In ie.Document.all
      .Range("B" & RowCount) = Left(itm.innerText, 1024)
   RowCount = RowCount + 1
   Next itm
End With
End Sub

enter image description here

Затем вам нужно будет проанализировать текст. Это несложно, но потребует дополнительных усилий.

Другой вариант - загрузить все содержимое веб-сайта, сохранить его как текстовый файл, импортировать данные, а затем проанализировать эти данные.

Sub Sample()
    Dim ie As Object
    Dim retStr As String

    Set ie = CreateObject("internetexplorer.application")

    With ie
        .Navigate "https://www1.nseindia.com/live_market/dynaContent/live_watch/get_quote/GetQuoteFO.jsp?underlying=VOLTAS&instrument=FUTSTK&type=-&strike=-&expiry=28MAY2020#"
        .Visible = True
    End With

    Do While ie.readystate <> 4: Wait 5: Loop

    DoEvents

    retStr = ie.document.body.innerText

    '~> Write the above to a text file
    Dim filesize As Integer
    Dim FlName As String

    '~~> Change this to the relevant path
    FlName = "C:\Users\ryans\OneDrive\Desktop\Sample.Txt"

    filesize = FreeFile()

    Open FlName For Output As #filesize

    Print #filesize, retStr
    Close #filesize
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

enter image description here

Мне не удалось запустить ни один из ваших примеров кода на моем компьютере.

...