时间戳

首页 > 解决方案 > 无法使用 vba 从已加载的网页导航到另一个网页

excel - 无法使用 vba 从已加载的网页导航到另一个网页

问题描述

为了从网页获取数据，我有以下内容，并在工作表中按列排列它们。我获取了一个 URL 数据，将它们放入单元格后，我想再次导航到该页面并获取我的最后信息。

Option Explicit

Public Sub GetInfo()
Dim ie As InternetExplorer: Set ie = New InternetExplorer
Dim i As Long
Const MAX_WAIT_SEC As Long = 20

With ie
    .Visible = True
    .Navigate2 "https://www.skroutz.gr/s/8988836/Mattel-Hot-Wheels-%CE%91%CF%85%CF%84%CE%BF%CE%BA%CE%B9%CE%BD%CE%B7%CF%84%CE%AC%CE%BA%CE%B9%CE%B1-%CE%A3%CE%B5%CF%84-%CF%84%CF%89%CE%BD-10.html"

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

    Dim finalPrices As Object, sellers As Object, availability As Object
    Dim products As Object, t As Date
    Set products = .Document.querySelectorAll(".card.js-product-card")
    t = Timer
    Do
        DoEvents
        ie.Document.parentWindow.execScript "window.scrollBy(0, window.innerHeight);", "javascript"
        Set finalPrices = .Document.querySelectorAll(".card.js-product-card span.final-price")
        Application.Wait Now + TimeSerial(0, 0, 1)
        If Timer - t > MAX_WAIT_SEC Then Exit Do
    Loop Until finalPrices.Length = products.Length


    Set sellers = .Document.querySelectorAll(".card.js-product-card .shop.cf a[title]")
    Set availability = .Document.querySelectorAll(".card.js-product-card span.availability")
With ThisWorkbook.Worksheets("TESTINGS")
        For i = 0 To 5

            If availability.Item(i).innerText = "Άμεσα Διαθέσιμο σε 1 έως 3 ημέρες" Then

            .Cells(2, i + 4) = sellers.Item(i)
            .Cells(3, i + 4) = finalPrices.Item(i).innerText
            .Cells(4, i + 4) = availability.Item(i).innerText
           End If        
        Next

        .Columns("D:I").AutoFit

    ie.Quit


    'Do While ie.Busy Or Not ie.ReadyState = READYSTATE_COMPLETE
    'DoEvents
    'Loop

    'Dim place As Object, mylink As String


    'For i = 0 To 5
    '        ie.Visible = True

    '        mylink = .Cells(2, i + 4).Value
    '        If mylink <> "" Then
    '        ie.Navigate2 mylink
    '        Set place = ie.Document.querySelector(".shop-stores.cf")
    '        .Cells(5, i + 4) = place.innerText
    '        End If

    'Next
    End With


 End With
End Sub

如果我添加以下内容来检查带有 URL 的单元格，并且如果它在里面有值然后打开 URL 获取值并完成然后我得到自动化错误

Do While ie.Busy Or Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

Dim place As Object, mylink As String


For i = 0 To 5
        ie.Visible = True

        mylink = .Cells(2, i + 4).Value
        If mylink <> "" Then
        ie.Navigate2 mylink
        Set place = ie.Document.querySelector(".shop-stores.cf")
        .Cells(5, i + 4) = place.innerText
        End If

Next

然后我在以下行收到自动化错误

Set place = ie.Document.querySelector(".shop-stores.cf")

不能从一页转到另一页？我是否必须创建一个不同的子并从 GetInfo() 子中调用它？

标签： excelvbaweb-scraping

解决方案

每次导航后您都需要适当的等待，并使您的 ie 对象在所有循环（例如结构）之外可见。您可以添加一个定时循环来设置place变量。我添加了If Not Is Nothing. .Quit完成ie对象后，最后有你的。

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, i As Long
    Const MAX_WAIT_SEC As Long = 20

    With ie
        .Visible = True
        .Navigate2 "https://www.skroutz.gr/s/8988836/Mattel-Hot-Wheels-%CE%91%CF%85%CF%84%CE%BF%CE%BA%CE%B9%CE%BD%CE%B7%CF%84%CE%AC%CE%BA%CE%B9%CE%B1-%CE%A3%CE%B5%CF%84-%CF%84%CF%89%CE%BD-10.html"

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

        'code with first link

        Dim place As Object, mylink As String

        For i = 0 To 5
            mylink = ActiveSheet.Cells(2, i + 4).Value
            If mylink <> vbNullString Then
                .Navigate2 mylink
                While .Busy Or .readyState < 4: DoEvents: Wend
                On Error Resume Next
                Set place = .document.querySelector(".shop-stores.cf")
                On Error GoTo 0
                If Not place Is Nothing Then
                    ActiveSheet.Cells(5, i + 4) = place.innerText
                    Set place  = Nothing
                End If
            End If
        Next
        .Quit
    End With
End Sub

推荐阅读