单击按钮后从新选项卡中提取数据

时间:2018-05-28 01:27:29

标签: vba shell web reference tabs

请帮助解决此问题。我已经在网上挖了两个多星期,但仍然无法解决问题。

我想从单击第一个标签中的按钮后打开的新标签中提取数据。

我无法引用新标签。代码仍然引用第一个选项卡。 我看了一下shell方法,但并不是真的理解它。

这是我的代码:

Sub taobao()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

    Dim i As Integer
    Dim x As Integer
    Dim k As Integer
    'Dim j As Integer
    Dim pricehq As String
    Dim price As String

    x = InputBox("initial:")
    k = InputBox("final:")         

    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

    On Error Resume Next
    For i = x To k

        Dim properties As String
        properties = Cells(i, 1).Value
        'MsgBox properties

        IE.navigate "https://sf.taobao.com/?spm=a213w.7398504.sfhead2014.2.1vQXr0&current=index"

        'Do While IE.Busy Or _
        'IE.readyState <> 4
        'DoEvents
        'Loop

        Application.Wait (Now + TimeValue("0:00:07"))

        Dim Doc As HTMLDocument
        Set Doc = IE.document

        Set ptyinput = IE.document.getElementById("J_SearchTxt")
        ptyinput.Value = properties

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

        Dim ptyclick As HTMLButtonElement
        Set ptyclick = Doc.querySelector("button[class=""J_SearchIpt search-btn iconfont-sf icon-sousuo""]")
        ptyclick.Click

        Application.Wait (Now + TimeValue("0:00:05"))

        Dim objshell As Object
        Set objshell = CreateObject("Shell.Application")
        Set IE = objshell.Windows(1)

        'Application.Wait (Now + TimeValue("0:00:03"))

        price = Trim(IE.document.getElementsByClassName("pai-xmpp-current-price")(0).innerText)
        Cells(1, 2).Value = price

     Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("Done!")
End Sub

1 个答案:

答案 0 :(得分:0)

如果您重置了.document,则应该选择新窗口。

代码:

Option Explicit

Sub taobao()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i As Long
    Dim x As Long
    Dim k As Long
    'Dim j AsLong
    Dim pricehq As String
    Dim price As String

    x = InputBox("initial:") '<== What happens  if empty?
    k = InputBox("final:")

    Dim IE As Object
    Set IE = New InternetExplorer ' CreateObject("InternetExplorer.Application")
    IE.Visible = True

    With ActiveSheet

        For i = x To k

            Dim properties As String
            properties = .Cells(i, 1).Value

            IE.navigate "https://sf.taobao.com/?spm=a213w.7398504.sfhead2014.2.1vQXr0&current=index"

            Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop

            Dim Doc As HTMLDocument '<== Why mixing late and early bound?
            Set Doc = IE.document
            Dim ptyinput As Object
            Set ptyinput = IE.document.getElementById("J_SearchTxt")

            ptyinput.Value = properties

            Dim ptyclick As HTMLButtonElement
            Set ptyclick = Doc.querySelector("button[class=""J_SearchIpt search-btn iconfont-sf icon-sousuo""]")
            ptyclick.Click

            Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop
            Set Doc = IE.document

            price = Trim$(Doc.getElementsByClassName("pai-xmpp-current-price")(0).innerText)
            .Cells(1, 2).Value = price

        Next i

    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox ("Done!")
End Sub

使用:标的物名称/地理位置

给出:

Image

注意:

不要忘记退出IE实例。