Ich habe ein Makro erstellt, das Börsenticker und eine Spalte durchläuft und mithilfe einer Webabfrage Daten zu diesen Börsentickern von Yahoo Finance abruft.
Es läuft gut für 10, 15, 20 Web-Abfragen, aber stürzt Excel irgendwann in den ersten 20 oder 30 Web-Abfragen ab.
Ich gebe als Erster zu, dass ich ein absoluter Laie in Sachen VBA-Code bin, aber ich habe ein paar Dinge ausprobiert, um dieses Problem zu beheben (Cache leeren, Pausen verwenden), und nichts hat funktioniert.
Es schlägt nicht jedes Mal beim gleichen Element fehl, aber in der Statusleiste erscheint immer der Text „Verbindung zum Internet wird hergestellt“, sodass ich das Gefühl habe, dass es etwas mit dem Timeout der Verbindung zu tun hat, aber ich bin mir an diesem Punkt nicht sicher, wie ich es angehen soll. Alle Ideen sind willkommen, ebenso wie jede Codeoptimierung, die ich möglicherweise übersehen habe. Danke!
Sub GetData()
Application.Calculation = xlManual
' make the website a variable
Dim sURL As String
Dim Ticker As String
Dim iRow As Integer
Dim iCol As Integer
Dim wqError As ErrObject
' create web query if it doesn't exist
If Worksheets("query").QueryTables.Count = 0 Then
With Worksheets("query").QueryTables.Add(Connection:="URL;", Destination:=Range("Query!A1"))
.Name = "market_data.asp"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With
End If
iRow = 2
iCol = 2
'Loop through Tickers
Do While Worksheets("Data").Range("A" & iRow).Value <> ""
Ticker = Worksheets("Data").Range("A" & iRow).Value
sURL = "http://finance.yahoo.com/q?s=" & Ticker
With Worksheets("query")
.Cells.Clear
.QueryTables(1).Connection = "URL;" & sURL
On Error Resume Next
.QueryTables(1).Refresh BackgroundQuery:=False
Set wqError = Err
On Error GoTo 0
If wqError.Number = 0 Then 'No error
.Range("B1").Copy Worksheets("Data").Cells(iRow, iCol)
.Range("B5").Copy Worksheets("Data").Cells(iRow, iCol + 1)
.Range("B13:B14").Copy Worksheets("Data").Cells(iRow, iCol + 2)
.Range("B18").Copy Worksheets("Data").Cells(iRow, iCol + 4)
.Range("B15").Copy Worksheets("Data").Cells(iRow, iCol + 5)
.Range("B22").Copy Worksheets("Data").Cells(iRow, iCol + 6)
.Range("B16").Copy Worksheets("Data").Cells(iRow, iCol + 7)
.Range("B20").Copy Worksheets("Data").Cells(iRow, iCol + 8)
.Range("B19").Copy Worksheets("Data").Cells(iRow, iCol + 9)
.Range("B25").Copy Worksheets("Data").Cells(iRow, iCol + 10)
.Range("B24").Copy Worksheets("Data").Cells(iRow, iCol + 11)
ElseIf wqError.Number <> 1004 Then
'Report error because it isn't the expected error 1004 Web query returned no data
MsgBox "Web query refresh for " & String(2, vbCrLf) & sURL & String(2, vbCrLf) & " returned error number " & wqError.Number & String(2, vbCrLf) & wqError.Description
End If
End With
iRow = iRow + 1
If iRow Mod 5 = 0 Then Delete_IE_Cache
If iRow Mod 20 = 0 Then ActiveWorkbook.Save
If iRow Mod 20 = 0 Then Application.Wait (Now + TimeValue("0:00:03"))
Loop
'Format results
With Sheets("data")
Range("A:M").HorizontalAlignment = xlCenter
Range("A:A").NumberFormat = "Text"
Range("D:D").NumberFormat = "Text"
Range("I:I").NumberFormat = "Text"
Range("B:C").NumberFormat = "0.00"
Range("E:H").NumberFormat = "0.00"
Range("K:M").NumberFormat = "0.00"
End With
Application.Calculation = xlCalculationAutomatic
End Sub
Antwort1
Ich sehe keinen Code, der darauf wartet, dass die Seite vollständig geladen wird ... Es ist vielleicht nicht notwendig, aber es würde nicht schaden, dies oben in Ihr Modul zu setzen und es dann nach der Navigation zur Website + zum Börsenticker aufzurufen.
Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Sub PauseApp(PauseInSeconds As Long)
Call AppSleep(PauseInSeconds)
End Sub
Dann in Ihrem Code,
sURL = "http://finance.yahoo.com/q?s=" & Ticker
Call sleepie(sURL)
Wie ich schon sagte, es löst Ihr Problem vielleicht nicht ganz, aber es wird auf jeden Fall helfen.