使用excel掠夺零售商网站的价格

时间:2018-02-15 11:08:33

标签: excel vba excel-vba web-scraping screen-scraping

我创建了一个宏来使用TagName来刮取零售商网站的价格,但是一旦TagName移动位置我就必须重新定位并更改位置编号。

我目前正在使用IF功能来对冲我的赌注,以定价。理想情况下,我需要使用Class或ID来恢复价格,但我几次尝试都失败了。

网站: https://www.usc.co.uk/puma-roma-basic-perforated-trainers-023210?colcode=02321069

样式023210/69(前6位= sName)(最后2位= SCOL)

任何帮助将不胜感激!以下是我目前的代码

Sub browse()

 Do Until IsEmpty(ActiveCell)
Dim sPath As String, sPathEnd As String, sName As String, SCOL As String

 sName = ActiveCell.Value
 SCOL = ActiveCell.Offset(0, 1)

Dim IE As New SHDocVw.InternetExplorer


IE.Visible = False
IE.navigate "https://www.usc.co.uk/" & sName & "?colcode=" & SCOL & ""

Do While IE.ReadyState <> READYSTATE_COMPLETE

Loop

''Debug.Print IE.LocationName, IE.LocationURL
Dim doc As HTMLDocument
Set doc = IE.Document
Dim SellingPrice As String
Dim OriginalPrice As String
Dim SellingPrice2 As String
Dim OriginalPrice2 As String

SellingPrice = Trim(doc.getElementsByTagName("SPAN")(154).innerText)
OriginalPrice = Trim(doc.getElementsByTagName("SPAN")(155).innerText)
SellingPrice2 = Trim(doc.getElementsByTagName("SPAN")(111).innerText)
OriginalPrice2 = Trim(doc.getElementsByTagName("SPAN")(112).innerText)


If SellingPrice = "Add to bag" Then


  ActiveCell.Offset(0, 2).Select
  ActiveCell.Value = SellingPrice2
  ActiveCell.Offset(0, 1).Select
  ActiveCell.Value = OriginalPrice2
  ActiveCell.Offset(1, -3).Select

Else


  ActiveCell.Offset(0, 2).Select
  ActiveCell.Value = SellingPrice
  ActiveCell.Offset(0, 1).Select
  ActiveCell.Value = OriginalPrice
  ActiveCell.Offset(1, -3).Select
End If

Loop


 Cells.Select
    Cells.EntireColumn.AutoFit

End Sub

1 个答案:

答案 0 :(得分:0)

我相信以下内容适合您,而不是使用Span,我使用ID作为售价和原价:

Sub browse()

Do Until IsEmpty(ActiveCell)
    Dim sPath As String, sPathEnd As String, sName As String, SCOL As String

     sName = ActiveCell.Value
     SCOL = ActiveCell.Offset(0, 1)

    Dim IE As New SHDocVw.InternetExplorer

    IE.Visible = False
    IE.navigate "https://www.usc.co.uk/" & sName & "?colcode=" & SCOL & ""

    Do While IE.ReadyState <> READYSTATE_COMPLETE

    Loop

    Set doc = IE.Document
    Dim SellingPrice As String
    Dim OriginalPrice As String
    Dim SellingPrice2 As String
    Dim OriginalPrice2 As String


    SellingPrice = doc.getElementbyID("dnn_ctr103436_ViewTemplate_ctl00_ctl07_lblSellingPrice").innerText
    OriginalPrice = doc.getElementbyID("dnn_ctr103436_ViewTemplate_ctl00_ctl26_lblTicketPrice").innerText

    If SellingPrice = "Add to bag" Then
      ActiveCell.Offset(0, 2).Select
      ActiveCell.Value = SellingPrice2
      ActiveCell.Offset(0, 1).Select
      ActiveCell.Value = OriginalPrice2
      ActiveCell.Offset(1, -3).Select
    Else
      ActiveCell.Offset(0, 2).Select
      ActiveCell.Value = SellingPrice
      ActiveCell.Offset(0, 1).Select
      ActiveCell.Value = OriginalPrice
      ActiveCell.Offset(1, -3).Select
    End If

Loop
 Cells.Select
    Cells.EntireColumn.AutoFit
End Sub

<强>更新

此外,我没有使用ActiveCell,而是在这个例子中从A1向下循环,直到找到没有任何数据的单元格:

Sub browse()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required

Count = 1
Do Until IsEmpty(ws.Range("A" & Count))
    Dim sPath As String, sPathEnd As String, sName As String, SCOL As String

    sName = ws.Range("A" & Count)
    SCOL = ws.Range("B" & Count)

    Dim IE As New SHDocVw.InternetExplorer

    IE.Visible = False
    IE.navigate "https://www.usc.co.uk/" & sName & "?colcode=" & SCOL & ""

    Do While IE.ReadyState <> READYSTATE_COMPLETE

    Loop

    Set doc = IE.Document
    Dim SellingPrice As String
    Dim OriginalPrice As String

    SellingPrice = doc.getElementbyID("dnn_ctr103436_ViewTemplate_ctl00_ctl07_lblSellingPrice").innerText
    OriginalPrice = doc.getElementbyID("dnn_ctr103436_ViewTemplate_ctl00_ctl26_lblTicketPrice").innerText

    ws.Range("C" & Count).Value = SellingPrice
    ws.Range("D" & Count).Value = OriginalPrice
    Count = Count + 1

Loop
ws.Cells.Select
ws.Cells.EntireColumn.AutoFit
End Sub