Извлечение данных из новой вкладки после нажатия кнопки - PullRequest
0 голосов
/ 28 мая 2018

Пожалуйста, помогите с этой проблемой.Я копался в Интернете более 2 недель, но все еще не могу решить проблему.

Я хотел бы извлечь данные из новой вкладки, которая открывается после нажатия кнопки на первой вкладке..

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

Вот мой код:

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 голосов
/ 28 мая 2018

Ваше новое окно должно быть выбрано при условии сброса .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.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...