根据元素列表

时间:2016-01-15 15:58:13

标签: excel

我正在尝试在Excel中创建一个工具,该工具将从亚马逊,尤其是Kindle(电子书)部分提取数据。亚马逊使用他们的电子书的ID,可以在他们的URL中看到。例如,B0192CTMYG是“哈利波特和魔法石”,你可以在这里看到:http://www.amazon.com/dp/product/B0192CTMYG

我想做的是,能够粘贴这些ID的列表,并为此工具检索2条信息: 1.价格。 (如果有的话) 2.如果可以作为Kindle Unlimited的一部分免费阅读。

理想情况下,此工具不仅会检查amazon.com,还会检查amazon.co.uk,amazon.fr,amazon.de等...

我不确定如何开始这个或者Excel是否是最好的工具,但它是我最熟悉的工具。话虽如此,我愿意接受建议。

谢谢!

EDIT1 22/01/2016

这是我目前拥有的适用于我的代码。首先,我选择将单元格修改作为代码的触发器。这要求您: 1.转到“Visual Basic”,然后在两个下拉菜单中,分别选择“工作表”和“更改”。 2.将“单元格B1”定义为ASIN,将B2定义为“In_KU?”

预期结果是在B1中键入ID,B2将返回HTML内部文本。

到目前为止,这是代码:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = Application.Workbooks("workbookname").Worksheets("sheet1").Range("ID").Row And _
Target.Column = Application.Workbooks("workbookname").Worksheets("sheet1").Range("ID").Column Then

Dim IE As New InternetExplorerMedium
IE.Visible = False
IE.navigate "http://www.amazon.co.uk/dp/" & Application.Workbooks("workbookname").Worksheets("sheet1").Range("ID").Value

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Dim doc As HTMLDocument
Set doc = IE.document
Dim BB As String
BB = Trim(doc.getElementsByTagName("span")(220).innerText)

Application.Workbooks("workbookname").Worksheets("sheet1").Range("In_KU?").Value = BB
IE.Quit
MsgBox ("Finished")

End If

End Sub

("span")(220)没有返回我需要的值“免费阅读”。在亚马逊的每个细节页面上都有大约13k行HTML,我不确定如何更具体。

EDIT2 08/02/2016

这是使用单个值的代码。我已重命名ID(ASIN):

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = Application.Workbooks("bretttest - Copy").Worksheets("sheet1").Range("ASIN").Row And _
Target.Column = Application.Workbooks("bretttest - Copy").Worksheets("sheet1").Range("ASIN").Column Then

Dim IE As New InternetExplorerMedium
IE.Visible = False
IE.navigate "http://www.amazon" & Application.Workbooks("bretttest - Copy").Worksheets("sheet1").Range("B1").Value & "/dp/" & Application.Workbooks("bretttest - Copy").Worksheets("sheet1").Range("ASIN").Value

Do
DoEvents

Loop Until IE.readyState = READYSTATE_COMPLETE

Dim doc As HTMLDocument
Set doc = IE.document
Dim BB As String

BB = Trim(doc.getElementById("kuBadge"))

Application.Workbooks("bretttest - Copy").Worksheets("sheet1").Range("In_KU?").Value = BB

IE.Quit
MsgBox ("Finished")

End If

End Sub

因此,当ASIN被添加到单元格A3时,它会在Kindle Unlimited徽章存在时返回“[object HTMLImageElement]”。现在我真正需要的是,它不仅适用于单个细胞而且适用于一系列细胞。因此,如果我在A3:A53中粘贴50个ASIN,它会为所有拥有它的人返回“[object HTMLImageElement]”,如果没有,则返回任何内容。我想我可能在某处需要一个“On Error”声明。

1 个答案:

答案 0 :(得分:1)

此VBA子网将浏览寻找链接的网页。您需要查看您正在查看的页面背后的代码以相应地修改它,但这是一个开始。您需要添加对" Microsoft HTML Object Library"的引用。和" Microsoft XML,v6.0" (或者不同的版本,取决于您的Excel版本)通过"工具/参考":

Public Sub parsePage()
  Dim ie As Variant
  Set ie = CreateObject("InternetExplorer.Application")
  ie.Visible = False

  Dim DOC As HTMLDocument
  Dim idx As Integer
  Dim data As String

  Dim links As Variant
  Dim lnk As Variant

  ie.navigate enter the url here
  Do
    DoEvents
  Loop Until ie.ReadyState = 4
  Set DOC = ie.Document

  Set links = DOC.getElementsByTagName("li")
  cnt = 0
  For Each lnk In links
    data = lnk.innerText
  Next
Wend
Set ie = Nothing

End Sub