|
| |
 | In diesem Forum haben Sie die Möglichkeit Kommentare, Fragen und Verbesserungsvorschläge zu den im vb@rchiv gelisteten Tipps und Workshops zu posten.
Hinweis:
Ein neues Thema kann immer nur über die jeweilige Tipps & Tricks bzw. Workshop Seite eröffnet werden! |
Fragen zu Tipps & Tricks und Workshops im vb@rchiv| Tipp 268: HTML-Quelltext einer Webseite auslesen | |  | | Autor: Walodja1987 |  Tipp anzeigenDatum: 30.11.10 07:48 |
| Hallo Leute,
ich möchte den Quelltext einer Website auslesen und habe euren Beitrag gelesen.
Bei mir ging leider der Webbrowser.Tag Befehl nicht. Ich bin nicht der erfahrenste VBA-Programmierer, aber ich lerne schnell 
Ich habe folgendes gemacht:
Ich habe in meinem Excel-Sheet ein Microsoft Web Browser Steuerelement eingefügt und dann in VBA nicht in "Module", sondern "Microsoft Excel Objekte -> Tabelle1(Tabelle1)" folgenden Code reingeschrieben.
' URL (Webseite) laden
Private Sub URL_Load(ByVal sURL As String)
Dim sQuelltext As String
WebBrowser1.Silent = True 'Lässt die Skriptfehler Meldung weg
WebBrowser1.Navigate sURL
While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
DoEvents
Wend
sQuelltext = WebBrowser1.Document.DocumentElement.outerHTML
Range("A1")=sQuelltext
End Sub
Private Sub cmdLoad_Click()
URL_Load "https://www.google.de"
End SubIch starte mein Programm aus "cmdLoad_Click()" und dann funktioniert es wunderbar. Ich bekomme den Quellcode der Seite. Aber wie oben erwähnt habe ich das ganze nicht im "Modul" geschrieben. Ich habe ein Modul eingefügt und dann versucht auch meinen Code da einzufügen, aber dann stört sich VBA am Webbrowser.Silent und mein, dass ein Objekt erforderlich sei.
Ich denke mal, dass ich dieses Webbrowser Steuerelement erst erstellen muss. Ich habe aber ehrlich gesagt keine Ahnung wie das gehen soll.
Ich möchte halt mit einem Klick auf einen Button (mit Verweis auf cmdLoad_Click) die Abfrage laufen lassen und deswegen muss das ganze in einem Modul geschrieben sein.
Wäre ganz nett von euch, wenn jemand eine Lösung parat hätte und mir den Unterschied erklären könnte, wann ich in ein Modul schreiben sollte und wann in "Microsoft Excel Objekt-> Tabell1(Tabelle1)". | |
| Re: HTML-Quelltext einer Webseite auslesen | | | | Autor: Walodja1987 | | Datum: 01.12.10 09:48 |
| Hallo Dieter,
da ich nicht der erfahrenste in VBA bin, wäre ich dir sehr dankbar, wenn du den von mir angegebenen Code dementsprechend anpassen könntest. Ich wüsste nicht, wie ich das "Control übergeben" soll.
Danke schon mal im Voraus.
Gruß Walodja1987 | |
| Re: HTML-Quelltext einer Webseite auslesen | | | | Autor: Walodja1987 | | Datum: 09.09.11 19:42 |
| Hallo zusammen,
habe eine Quelltext-Abfrage geschrieben, die in regelmäßigen Zeitabständen Quoten von einer Internetseite ausliest. Eigentlich funktioniert das wunderbar, nur nach der zweiten Halbzeit bleibt aufeinmal das Webbrowser Steuerelement weiß und es wird einfach kein Code mehr ausgelesen. Ich verzweifle schon daran. Mein Vermutung ist, dass der Internet Explorer da irgendeinen Mist baut. Anders kann ich mir das nicht erklären.
Ich wüde mich freuen, wenn mir jemand helfen könnte.
Mein Code sieht folgendermaßen aus:
Public Sub URL_Load()
Dim sQuelltext As String
Dim m1 As String
Dim m2 As String
Dim q(3) As Variant
Dim quote_ori(3) As Variant
Dim quote(3) As Variant
Dim d As Integer
Dim le As Integer
Dim sURL As String
Dim s As Boolean
Dim outcomes(3) As String
Dim Live As Worksheet
Dim Data As Worksheet
Set Live = Application.Worksheets("Live")
Set Data = Application.Worksheets("Data")
Live.Activate
StartStop = Live.Cells(5, 10)
TimeDist = Live.Cells(4, 2)
sURL = Live.Cells(1, 2)
Team1 = Live.Cells(2, 2)
Team2 = Live.Cells(2, 4)
Cells(5, 11) = ""
j = Range("G9:G65536").Find("").Row
anf = Timer
B = 5
Do While Live.Cells(5, 11) = ""
Again:
WebBrowser1.Navigate sURL
sQuelltext = WebBrowser1.Document.DocumentElement.OuterHTML
While WebBrowser1.Busy
DoEvents
Wend
zeit = Timer
a1 = InStr(1, sQuelltext, "mOutcomes.push('" & Team1)
If a1 = 0 Then
Start = Timer
Do While Timer < Start + B
DoEvents
If StartStop = "x" Then
MsgBox "Abfrage erfolgreich beendet"
Exit Sub
End If
Loop
sQuelltext = ""
While WebBrowser1.Busy
DoEvents
Wend
GoTo Again
End If
EA = InStr(a1, sQuelltext, "1X2")
outcomes(0) = Team1
outcomes(1) = "X"
outcomes(2) = Team2
For t = 0 To 2
quote_ori(t) = InStr(EA + 30, sQuelltext, outcomes(t))
quote_ori(t) = InStrRev(sQuelltext, "'odd' : ", quote_ori(t))
quote_ori_end = InStr(quote_ori(t) + 11, sQuelltext, Chr$(34))
laenge = quote_ori_end - quote_ori(t) - 9
quote(t) = Mid(sQuelltext, quote_ori(t) + 9, laenge)
Next t
quote(0) = CLng(quote(0)) / 100
quote(1) = CLng(quote(1)) / 100
quote(2) = CLng(quote(2)) / 100
If Live.Cells(3, 4) = Team1 Then 'Live.Cells(1, 3) = Team1 Then
Live.Cells(11, 2) = quote(1) 'X Quote
Live.Cells(12, 2) = quote(2) 'Team2 Quote
ElseIf Live.Cells(3, 4) = "X" Then
Live.Cells(11, 2) = quote(0) 'Team1 Quote
Live.Cells(12, 2) = quote(2) 'Team2 Quote
ElseIf Live.Cells(3, 4) = Team2 Then
Live.Cells(11, 2) = quote(0) 'Team1 Quote
Live.Cells(12, 2) = quote(1) 'X Quote
End If
If (quote(0) <> Live.Cells(j - 1, 7) Or quote(1) <> _
Live.Cells(j - 1, 8) Or quote(2) <> Live.Cells(j - 1, 9)) And _
quote(0) <> 0.9 Then
Live.Cells(j, 6) = (zeit - anf) / 60
Live.Cells(j, 7) = quote(0)
Live.Cells(j, 8) = quote(1)
Live.Cells(j, 9) = quote(2)
j = j + 1
ElseIf quote(0) = 0.9 And Live.Cells(j - 1, 7) <> 0.9 Then
Live.Cells(j, 6) = (zeit - anf) / 60
Live.Cells(j, 7) = "-"
Live.Cells(j, 8) = "-"
Live.Cells(j, 9) = "-"
j = j + 1
End If
sQuelltext = ""
Start = Timer
Do While Timer < Start + TimeDist
DoEvents
If Live.Cells(5, 11) = "x" Then
MsgBox "Abfrage erfolgreich beendet"
Exit Sub
End If
Loop
Loop
End SubHat jemand Verbesserungsvorschläge, so wäre ich demjenigen auch sehr dankbar. | |
| Sie sind nicht angemeldet!
Um einen neuen Beitrag schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
sevAniGif (VB/VBA) 
Anzeigen von animierten GIF-Dateien
Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Weitere InfosTipp des Monats Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
Mai 2024
Sie sind aktuell nicht angemeldet.