Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

gebraucht preis abfrage amazon


Betrifft: gebraucht preis abfrage amazon von: jbender
Geschrieben am: 01.12.2017 05:10:46

Hallo

ich habe folgendes problem und bin so langsam am verzweifeln.....

ich habe knapp 13.000 bücher aus einem nachlass aus meiner familie übernommen.

1500 bücher habe ich bis jetzt eingelagert und mit der software "BooKcook Pro" mir die dazugehörigen infos rausgesucht.

Leider sucht mit das Programm keine Preise automatisch mit raus und trägt sie ein wie ich es anfangs gedacht hatte.

Für mich ist auch nur wichtig eine ungefähre vorstellung zu bekommen von jedem buch was es gebraucht überhaupt noch wert ist, um nicht unnötig platz im regal zu verschwenden mit büchern die unter 5 euro gehandelt werden.

ich habe mich schon doof gegoogelt um eine lösung zu finden wie ich in meiner excel tabelle zur jeder isbn automatisch einen gebraucht preis suchen und eintragen lassen kann.

ich bin hier im foren archiv auf eine lösung von franz gestossen die aber leider nicht mehr richtig funktioniert.

hier einmal der link zum beitrag:
https://www.herber.de/forum/archiv/1376to1380/1377946_ExcelVBA_Webabfrage.html#1377946

hier einmal der link zum beitrag:
https://www.herber.de/forum/archiv/1376to1380/1377946_ExcelVBA_Webabfrage.html#1377946

und hier einmal das makro zu seiner datei

Sub webabfrage()
         
          Dim i As Long, Zeile As Long
          Dim Itext As String
          Dim MyUrl As String
          Dim MyISBN As String
          Dim IEApp As Object
          Dim IEDocument As Object
          Dim strTitel As String, strAutor As String, strPreis, varDatum, varZeile
          
          On Error GoTo Fehler
          varZeile = Application.InputBox("Startzeile für Einlesen der Links", _
                      "Amazon-Links auswerten", ActiveCell.Row, Type:=1)
          If varZeile <= 1 Then Exit Sub
          For Zeile = varZeile To Cells(Rows.Count, 2).End(xlUp).Row
            MyISBN = Cells(Zeile, 2).Text
MyUrl = "http://www.amazon.de/s/ref=nb_sb_noss?__mk_de_DE=" _
               & "%C3%85M%C3%85%C5%BD%C3%95%C3%91&url" _
               & "=search-alias%3Daps&field-keywords=" & MyISBN
             
             Set IEApp = CreateObject("InternetExplorer.Application")
                 IEApp.Visible = True
                 IEApp.Navigate MyUrl
                 Do
                 DoEvents
                 
                 Loop Until IEApp.readyState = 4
                 Set IEDocument = IEApp.Document
                 Itext = IEDocument.body.innertext
                 IEApp.Quit
                 Set IEApp = Nothing
                 Set IEDocument = Nothing
                 
             'Text vor Keyword (ISBN in Anführungszeichen) abschneiden
             Itext = Mid(Itext, InStr(1, Itext, """" & MyISBN & """"))
       '       Debug.Print Itext
             'Text nach dem Preis abschneiden
             strPreis = ""
             If InStr(1, Itext, "gebraucht (") > 0 Then
               Itext = Left(Itext, InStr(1, Itext, "gebraucht (") - 1)
               strPreis = Trim(Mid(Itext, InStrRev(Itext, "EUR")))
               Cells(Zeile, 8) = strPreis
             End If
             If InStr(1, Itext, "neu (") > 0 Then
               Itext = Left(Itext, InStr(1, Itext, "neu (") - 1)
               strPreis = Trim(Mid(Itext, InStrRev(Itext, "EUR")))
               Cells(Zeile, 7) = strPreis
             End If
             If Cells(Zeile, 7) = "" And Cells(Zeile, 8) = "" Then
               Cells(Zeile, 7) = "keine Preisinfo"
             End If
             'Text vor letztem "EUR " abschneiden
             If InStrRev(Itext, "EUR ") > 0 Then
               Itext = Left(Itext, InStrRev(Itext, "EUR ") - 1)
             End If
             'Text nach letzter ")" abschneiden
             If InStrRev(Itext, ")") > 0 Then
               Itext = Left(Itext, InStrRev(Itext, ")"))
             End If
             'Zeilenschaltungen durch Leerzeichen ersetzen
             Itext = Trim(Replace(Itext, Chr(10), " "))
             Itext = Trim(Replace(Itext, Chr(13), " "))
             'doppelte Leerzeichen durch einzelnes Leerzeichen ersetzen
             Itext = Trim(Replace(Itext, "  ", " "))
             strTitel = ""
             strAutor = ""
             varDatum = ""
             'Prüfen, ob " von " im Text vorhanden - trennt Titel und Autor
             If InStrRev(Itext, " von ") > 0 Then
               strTitel = Left(Itext, InStrRev(Itext, " von ") - 1)
               strTitel = Trim(Mid(strTitel, Len(MyISBN) + 3))
               strAutor = Mid(Itext, InStrRev(Itext, " von ") + 5)
               strAutor = Trim(Left(strAutor, InStrRev(strAutor, "(") - 1))
             Else
               'Titel ohne Autor
               strTitel = Itext
               strTitel = Trim(Mid(strTitel, Len(MyISBN) + 3))
             End If
             'Prüfen ob "(" im Text - danach beginnt meistens Erscheinungsdatum
             If InStrRev(Itext, "(") > 0 Then
               varDatum = Trim(Mid(Itext, InStrRev(Itext, "(") + 1))
               varDatum = Replace(varDatum, ")", "")
             End If
Resume01:
             Cells(Zeile, 5).Value = strTitel
             Cells(Zeile, 4).Value = strAutor
             Cells(Zeile, 6).Value = varDatum
           Next Zeile
Fehler:
           With Err
             Select Case .Number
               Case 0 'Alles OK
               Case 5 'Fehler bei der Instr-Suche bzw. der Mid- oder Left-Funktion
                 Resume Resume01
               Case Else
                 MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
             End Select
           End With
       End Sub




Kann mir jemand dieses Makro so anpassen das es wieder funktioniert und mir die preise wieder ordentlich einträgt?

  

Betrifft: AW: gebraucht preis abfrage amazon von: fcs
Geschrieben am: 01.12.2017 09:05:02

Hallo jbender,

scheinbar hat Amazon, den Aufbau der Webseiten modifiziert, so dass meine Analyse des Webseiten-Inhalts nicht mehr so recht funktioniert.

Leider hab ich privat nach Umzug noch keinen Internetzugang um notwendige Anpassungen am Makro zu machen und zu testen.
Ich nehme an, dass die Suchbegriffe angepasst werden müssen, um den gesamten Text in die gewünschten Teile zu zerlegen und für Excel aufzubereiten.

Gruß
Franz


  

Betrifft: AW: gebraucht preis abfrage amazon von: Christoph Zahn
Geschrieben am: 01.12.2017 10:07:35

Hallo,
melde dich mal unter der Mail:
zahni2@hotmail.de

gruss christoph


Beiträge aus den Excel-Beispielen zum Thema "gebraucht preis abfrage amazon "