Hallo zusammen,
ich bin noch unerfahren im Umgang mit VBA und versuche gerade aus Amazon den Bestseller-Rang eines Artikels auszulesen.
Dazu habe ich auch in einem anderen Forum einen alten Beitrag gefunden, der genau das gleiche schonmal gemacht hat, leider funktioniert das bei mir nicht.
Sub ISBNRang()
Dim IEApp As Object
Dim ISBN$, Rang$, lPos&, Inhalt$
ISBN = "3596164532 "
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
IEApp.Navigate "http://www.amazon.de/gp/product/" & ISBN
Do Until IEApp.Busy = False
Loop
Inhalt = IEApp.Document.DocumentElement.outertext
lPos = InStr(1, Inhalt, "Amazon Bestseller-Rang")
If lPos > 0 Then _
Rang = Mid$(Inhalt, lPos + 28, InStr(lPos + 28, Inhalt, " ") - lPos - 28)
MsgBox "Amazon Bestseller-Rang: Nr. " & Rang
IEApp.Quit
Set IEApp = Nothing
End Sub
Ich habe das ganze dann zum Test mit diesem Artikel versucht. https://www.amazon.de/dp/3426281538
Habe den Code natürlich bezüglich Artikelnummer und URL-Vorlage angepasst und habe durch Visibile = True auch gesehen, dass er den richtigen Artikel öffnet.
Nun das komische, wir haben den Code x-mal probiert und zwei Mal gab er das richtige Ergebnis aus, obwohl wir keine Änderung vorgenommen haben ging es danach nicht mehr.
Ich konnte bisher leider nicht rausfinden was genau das Problem ist. Außerdem habe ich versucht das ganze statt in IE in Chrome zu öffnen, ich kriege es zwar hin die gewünschten Artikel auf Amazon in Chrome öffnen zu lassen, aber kann die Daten nicht auslesen.
Unser Textcode sieht aktuell also so aus:
Sub Test()
Dim IEApp As Object
Dim ASIN$, Rang$, lPos&
Dim Inhalt As String
ASIN = Cells(2, 1)
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = True
IEApp.Navigate "http://www.amazon.de/dp/" & ASIN
Do Until IEApp.Busy = False
Loop
Inhalt = IEApp.Document.DocumentElement.outertext
lPos = InStr(1, Inhalt, "Amazon Bestseller-Rang:")
MsgBox lPos
If lPos > 0 Then _
Rang = Mid$(Inhalt, lPos + 28, InStr(lPos + 28, Inhalt, " ") - lPos - 28)
MsgBox "Amazon Bestseller-Rang: Nr. " & Rang
IEApp.Quit
Set IEApp = Nothing
End Sub
|