Как выбрать значение из выпадающего на веб-URL? - PullRequest
1 голос
/ 26 апреля 2019

Я пытаюсь выбрать данные из раскрывающегося списка в веб-URL, весь мой код работает нормально, но я не могу выбрать значение из раскрывающегося списка.

Sub pulldata2()
        Dim tod As String, UnderLay As String
        Dim IE As Object
        Dim doc As HTMLDocument

'Html table

    Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
    Dim TrgRw As Long, TrgCol As Long

'Создать новый лист

    tod = ThisWorkbook.Sheets("URLList").Range("C2").Value   
    have = False
    For Each sht In ThisWorkbook.Sheets
        If sht.Name = tod Then
        have = True
        Exit For
        End If
    Next sht

    If have = False Then
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = tod
    Else
    If MsgBox("Sheet " & tod & " already exists Overwrite Data?", vbYesNo) = vbNo Then Exit Sub
    End If

' Запустить Internetexplorer

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.navigate "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=25APR2019"

        Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
        Loop

    Set doc = IE.document

Dim ColOff As Long

'Поместить данные на лист и перейти к следующему URL

For Nurl = 2 To 191
ColOff = (Nurl - 2) * 23
TrgRw = 1
    UnderLay = ThisWorkbook.Sheets("URLList").Range("A" & Nurl).Value
    doc.getElementById("underlyStock").Value = UnderLay
    doc.parentWindow.execScript "goBtnClick('stock');", "javascript"

'теперь я хочу выбрать данные из выпадающего списка id = дата, значение = 27JUN2019

doc.querySelector("Select[name=date] option[value=27JUN2019]").Selected = True


        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        Set Tbl = doc.getElementById("octable")

        ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff + 1).Value = UnderLay
        ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff + 1).Font.Size = 20
        ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff + 1).Font.Bold = True
        ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff + 1).Select
        TrgRw = TrgRw + 1


        For Each Rw In Tbl.Rows
            TrgCol = 1
            For Each Cel In Rw.Cells
                ThisWorkbook.Sheets(tod).Cells(TrgRw, ColOff + TrgCol).Value = Cel.innerText
                TrgCol = TrgCol + Cel.colSpan   ' if Column span is > 1 multiple
            Next Cel
            TrgRw = TrgRw + 1
        Next Rw

    TrgRw = TrgRw + 1
    Next Nurl

' выйти из internetexplorer

        IE.Quit
        Set IE = Nothing
    End Sub

почему мой код не работает, я новичок в VBA, пожалуйстапомогите найти ошибку в моем коде.

1 Ответ

2 голосов
/ 26 апреля 2019

Просто измените URL, а не используйте раскрывающийся список

https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=27JUN2019

Вы также можете использовать xhr для получения контента, а не медленного браузера.Я использую буфер обмена, чтобы выписать таблицу.

Option Explicit
Public Sub GetInfo()
    Dim html As Object, hTable As Object, ws As Worksheet, clipboard As Object
    Set html = New HTMLDocument
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=27JUN2019", False
        .send
        html.body.innerHTML = .responseText
        Set hTable = html.getElementById("octable")
        clipboard.SetText hTable.outerHTML
        clipboard.PutInClipboard
        ws.Range("A1").PasteSpecial
    End With
End Sub

Альтернатива:

1) Вы можете зациклить tr и td в hTable выше, чтобы выписать таблицу

2) Вы также можете использовать powerquery из Интернета (через вкладку данных Excel 2016+ или бесплатную надстройку PowerQuery для 2013 года. Вы вставляете URL в верхнюю часть всплывающего браузера и нажимаетеПерейдите, затем выберите таблицу для импорта.


Изменение запасов:

Запасы являются частью строки запроса URL, например, Symbol = NIFTY, так что вы можете объединить новый символ в URL во времяцикл

"https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=" & yourSymbolGoesHere & "&date=27JUN2019"

Если вы действительно хотите использовать IE, обязательно заключите значение атрибута в '', например '27JUN2019'

Option Explicit
'VBE > Tools > References: Microsoft Internet Controls
Public Sub ClickButton()
    Dim ie As InternetExplorer
    Const URL As String = "https://nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTIDX&symbol=NIFTY&date=25APR2019"
    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 URL

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("[value='27JUN2019']").Selected = True
            Stop
        End With
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...