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

Excel 无法使用vba从已加载的网页导航到另一个网页,excel,vba,web-scraping,Excel,Vba,Web Scraping,为了从网页中获取数据,我有以下几点,并将它们安排在工作表中的每一列。我获取其中一个数据,它是一个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 =

为了从网页中获取数据,我有以下几点,并将它们安排在工作表中的每一列。我获取其中一个数据,它是一个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
不能从一页转到另一页?
我是否必须创建一个不同的子对象并从GetInfo()子对象调用它?

每次导航后需要适当的等待2,并使ie对象在所有循环(例如结构)之外可见。您可以添加一个定时循环来设置
place
变量。我已经添加了一个
的安全保护测试,如果不是什么
。在使用完
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
选项显式
公共子GetInfo()
Dim ie作为新的InternetExplorer,我希望
常量最大等待时间=20秒
与ie
.Visible=True
.导航2“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“
当.Busy或.readyState<4:DoEvents:Wend时
'带第一个链接的代码
暗显位置作为对象,mylink作为字符串
对于i=0到5
mylink=ActiveSheet.Cells(2,i+4).Value
如果mylink vbNullString,则
.导航2 mylink
当.Busy或.readyState<4:DoEvents:Wend时
出错时继续下一步
Set place=.document.querySelector(“.shop stores.cf”)
错误转到0
如果没有地方就什么都不是了
ActiveSheet.Cells(5,i+4)=place.innerText
地点=没有
如果结束
如果结束
下一个
退出
以
端接头

第二次导航后,请确保您有另一次适当的等待。你不需要让ie在循环中可见。你能提供第二个url的例子吗?你的意思是什么?第二个链接是我是否将多余的代码放在了正确的位置?我在.Busy或.readyState<4:DoEvents:Wend时出现了自动错误,现在有时在IE未正确关闭时发生。关闭IE。稍等片刻,然后再次尝试运行代码。我的中没有。退出。虽然我只是在最后加了一句。如果在循环过程中使用了ie对象,则不再使用ie对象,因此将出现自动化错误。如果需要,请在使用完ie对象后退出。
Set place = ie.Document.querySelector(".shop-stores.cf")
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