You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA网页抓取功能优化求助:Class容错与产品数量判断

Solution for MyProtein VBA Scraper Enhancements

Hey there! Let's fix up your VBA scraper to handle those two missing features you need. I've refactored your code to address both requirements while keeping it clean and error-resistant.

Key Changes Made

1. Price Fallback Logic

Created a helper function GetProductPrice that first tries to fetch the price from the athenaProductBlock_fromValue class. If that element doesn't exist, it falls back to athenaProductBlock_priceValue instead. This avoids hardcoding duplicate checks for each product.

2. Handle Insufficient Search Results

Before attempting to extract products, we first grab all search result blocks into a collection. If the number of results is less than 4, we skip the current keyword entirely (no more index-out-of-bounds errors!) and move to the next one.

Modified Full Code

Sub pronutrition()
    Dim ie As Object
    Dim my_url As String
    Dim i As Long, LastRow As Long
    Dim Rng As Range, cell As Range
    Dim productBlocks As Object
    Dim productCount As Integer
    
    Set ie = CreateObject("InternetExplorer.Application")
    my_url = "https://www.myprotein.ro/"
    ie.Visible = True
    
    i = 20
    LastRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
    Set Rng = ActiveSheet.Range("A20:A" & LastRow)
    
    For Each cell In Rng
        ' Navigate to homepage and search
        ie.navigate my_url
        Do While ie.Busy Or ie.ReadyState <> 4 ' Added ReadyState check for reliability
            DoEvents
        Loop
        Wait 1
        
        ie.Document.getElementsByName("search")(0).Value = cell.Value
        ie.Document.getElementsByClassName("headerSearch_button")(0).Click
        
        Do While ie.Busy Or ie.ReadyState <> 4
            DoEvents
        Loop
        Wait 2
        
        ' Get all product blocks from search results
        Set productBlocks = ie.Document.getElementsByClassName("athenaProductBlock")
        productCount = productBlocks.Count
        
        ' Check if we have at least 4 results
        If productCount < 4 Then
            Debug.Print "Skipping keyword '" & cell.Value & "' - only " & productCount & " results found"
            i = i + 1
            GoTo NextKeyword ' Skip to next search term
        End If
        
        ' Extract products 0-3 with price fallback
        ActiveSheet.Range("B" & i).Value = productBlocks(0).getElementsByClassName("athenaProductBlock_productName")(0).innerText & " - " & GetProductPrice(productBlocks(0))
        ActiveSheet.Range("C" & i).Value = productBlocks(1).getElementsByClassName("athenaProductBlock_productName")(0).innerText & " - " & GetProductPrice(productBlocks(1))
        ActiveSheet.Range("D" & i).Value = productBlocks(2).getElementsByClassName("athenaProductBlock_productName")(0).innerText & " - " & GetProductPrice(productBlocks(2))
        ActiveSheet.Range("E" & i).Value = productBlocks(3).getElementsByClassName("athenaProductBlock_productName")(0).innerText & " - " & GetProductPrice(productBlocks(3))
        
        i = i + 1
        
NextKeyword:
    Next cell
    
    ie.Quit
    MsgBox "Done!"
End Sub

' Helper function to get price with fallback
Function GetProductPrice(productBlock As Object) As String
    Dim priceElem As Object
    
    ' Try fromValue first
    On Error Resume Next
    Set priceElem = productBlock.getElementsByClassName("athenaProductBlock_fromValue")(0)
    On Error GoTo 0
    
    ' If fromValue not found, try priceValue
    If priceElem Is Nothing Then
        On Error Resume Next
        Set priceElem = productBlock.getElementsByClassName("athenaProductBlock_priceValue")(0)
        On Error GoTo 0
    End If
    
    ' Return price text or "N/A" if neither exists
    If Not priceElem Is Nothing Then
        GetProductPrice = priceElem.innerText
    Else
        GetProductPrice = "N/A"
    End If
End Function

' Assuming your existing Wait function looks like this (if not, replace with Application.Wait)
Sub Wait(seconds As Integer)
    Application.Wait Now + TimeValue("00:00:" & seconds)
End Sub

Additional Notes

  • Added ie.ReadyState <> 4 checks alongside ie.Busy to make page loading more reliable (ReadyState 4 means the page is fully loaded).
  • Used productBlocks to store all result elements once, instead of querying the DOM multiple times - this makes the code faster and more efficient.
  • Added a Debug.Print statement to log skipped keywords to the Immediate Window, so you can track which terms had insufficient results.
  • The helper function GetProductPrice encapsulates the fallback logic, making the main code cleaner and easier to maintain.

内容的提问来源于stack exchange,提问作者Catalin

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.05.06 21:02:36