Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
11.09.2018 17:34:28 |
bookhook |
|
|
vba webabfrage |
16.09.2018 12:49:45 |
Ben |
|
|
|
20.09.2018 09:36:48 |
Ulrich |
|
|
|
22.09.2018 16:19:51 |
Ben |
|
|
|
19.09.2018 11:22:21 |
Gast62080 |
|
|
Von:
Ben |
Datum:
16.09.2018 12:49:45 |
Views:
505 |
Rating:
|
Antwort:
|
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.
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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 |
|
|
vba webabfrage |
16.09.2018 12:49:45 |
Ben |
|
|
|
20.09.2018 09:36:48 |
Ulrich |
|
|
|
22.09.2018 16:19:51 |
Ben |
|
|
|
19.09.2018 11:22:21 |
Gast62080 |
|
|