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. |
Forenübersicht Suchen Forumsregeln
Mai 2024
Sie sind aktuell nicht angemeldet.
