Thema Datum  Von Nutzer Rating
Antwort
11.09.2018 17:34:28 bookhook
NotSolved
Blau vba webabfrage
16.09.2018 12:49:45 Ben
NotSolved
20.09.2018 09:36:48 Ulrich
NotSolved
22.09.2018 16:19:51 Ben
NotSolved
19.09.2018 11:22:21 Gast62080
NotSolved

Ansicht des Beitrags:
Von:
Ben
Datum:
16.09.2018 12:49:45
Views:
503
Rating: Antwort:
  Ja
Thema:
vba webabfrage

Hallo,

folgender VBA-Code liest eine Beispiel-Information aus der Webseite aus.

Damit dieser Code funktioniert, muss ein Verweis auf "Microsoft VBScript Regular Expressions 5.5" gesetzt werden.

Option Explicit

Sub TEST()
    Dim URL As String
    Dim myISBN As String
    myISBN = "3825859438"
    URL = "https://www.eurobuch.com/buch/isbn/" & myISBN & ".html?doAbeDe=1&doAchtungBuecher=1&doAlibris=1&doAmazon=1&doAmazonCom=1&doAmazonEs=1&doAmazonFr=1&doAmazonIt=1&doAmazonUk=1&doAudiobooks=0&doBbBuch=1&doBetterworld=1&doBiblio=1&doBooklooker=1&doBuchfreund=1&doEBay=1&doEbooks=0&doGoogle=1&doHugendubel=1&doJokers=1&doKobo=1&doLehmanns=1&doMedimops=1&doProlibri=1&doRebuy=1&doThriftbooks=1&doZVAB=1&doZweitausendeins=1&fromDateDays=7&isbn=" & myISBN & "&mediatype=0&mediatypeSelect=0&noBids=1&noReprint=0&pageLen=20&proSearch=1&sCountry=DE&search_submit=suchen&updatePresets=1&updateProState=1&usedState=2"
    
    Dim sText As String
    sText = URL_Load(URL)
    Dim minPrice As String, maxPrice As String, avgPrice As String
    minPrice = GetPrice(Text:=sText, pattern:="<span id=""results_min_price"">(.*?)</span>")
    maxPrice = GetPrice(Text:=sText, pattern:="<span id=""results_max_price"">(.*?)</span>")
    avgPrice = GetPrice(Text:=sText, pattern:="<span id=""results_avg_price"">(.*?)</span>")
End Sub

' Quelle: http://www.herber.de/forum/archiv/1044to1048/1044769_Inhalt_aus_URLWebseiten_auslesen.html
' modifiziert, dass der Inhalt zurückgegeben wird:
Private Function URL_Load(ByVal sURL As String) As String
   Dim appIE As Object
   Dim sTxt As String
   Set appIE = CreateObject("InternetExplorer.Application")
   appIE.navigate sURL
   Do: Loop Until appIE.Busy = False
   Do: Loop Until appIE.Busy = False
   sTxt = appIE.document.DocumentElement.outerHTML
   Set appIE = Nothing
   Close
   URL_Load = sTxt
End Function

Function GetPrice(Text As String, pattern As String) As String
    Dim Regex As New VBScript_RegExp_55.RegExp
    Dim sOut As String
    With Regex
        .pattern = pattern
        .IgnoreCase = True
        
        If .TEST(Text) Then
            Dim mc As VBScript_RegExp_55.MatchCollection
            Set mc = .Execute(Text)
            If Not mc Is Nothing Then
                If mc.Count = 1 Then
                    sOut = mc.Item(0).SubMatches(0)
                End If
            End If
        End If
    End With
    GetPrice = sOut
End Function

Beim Test werden die Preise als String in den Variablen minPrice, maxPrice und avgPrice gespeichert.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
11.09.2018 17:34:28 bookhook
NotSolved
Blau vba webabfrage
16.09.2018 12:49:45 Ben
NotSolved
20.09.2018 09:36:48 Ulrich
NotSolved
22.09.2018 16:19:51 Ben
NotSolved
19.09.2018 11:22:21 Gast62080
NotSolved