网络定价抓取工具,创建 URL 循环

问题描述 投票:0回答:1

我正在尝试创建一个网络抓取工具,从 B 列中的 URL 获取定价。

我想要一个循环,以便将 HTML 中的价格提取到 C 列。

我的代码给出了“自动化错误”。

当我将单元格指定为“范围”时,我的代码可以在没有循环的情况下工作,但我不想重复代码 50 次。

出于隐私原因,我隐藏了“ClassName”。

Sub FetchPrices_data()

    Dim Model As String
    Dim request As Object
    Dim response As String
    Dim html As New HTMLDocument
    Dim Price As String
    Dim i As Integer
    
    For i = 1 To 50
    
        Model = Range("B" & i).Value
        
        Set request = CreateObject("MSXML2.XMLHTTP")
        
        request.Open "GET", Model, False
        
        request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        
        request.send
        
        response = StrConv(request.responseBody, vbUnicode)
            
        html.body.innerHTML = response
            
        Price = html.getElementsByClassName(" Hidden ").Item(0).innerText
                
        Range("C" & i).Value = Price
    
    Next i
    
End Sub
excel vba web-scraping
1个回答
0
投票

谢谢您的提示!现在已经解决了。 我还添加了一个错误指示器。
这是我为解决该问题所做的操作:

Sub FetchPrices_data()

    Dim Model As String
    Dim request As Object
    Dim response As String
    Dim html As New HTMLDocument
    Dim Price As String
    Dim i As Integer
    
    For i = 2 To 35        
        Model = Range("B" & i).Value
        
        Set request = CreateObject("MSXML2.XMLHTTP")
        
        If request Is Nothing Then
            Range("B" & i).Value = "URL Error."
            Exit Sub
        End If
        
        request.Open "GET", Model, False
        
        request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        
        request.send
        
        response = StrConv(request.responseBody, vbUnicode)
            
        html.body.innerHTML = response
            
        If Not html.getElementsByClassName(" *Hidden* ").Item(0) Is Nothing Then
            Price = html.getElementsByClassName(" *Hidden* ").Item(0).innerText
            Range("C" & i).Value = Price
        Else
            Range("C" & i).Value = "URL Error"
        End If                                                        
    Next i        
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.