Question

我正在尝试从Web URL的下拉列表中选择数据，我的所有代码都工作正常，但无法从下拉列表中选择值。

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

“ HTML表格”

    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 = date，value = 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

'退出互联网浏览器

        IE.Quit
        Set IE = Nothing
    End Sub

为什么我的代码不起作用，我是VBA的新手，请帮助查找我的代码中的错误。

Answer 1

只需更改网址，而不使用下拉列表

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）您可以在上面的hTable中循环tr和td来写出表

2）您也可以使用powerquery from web（通过Excel 2016+数据标签，或使用2013年免费的powerquery加载项。将网址粘贴到弹出浏览器的顶部，然后按Go，然后选择表导入。

变更库存：

库存是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

如何从下拉式网址中选择值？

1 个答案: