Import mehrere CSV-Dateien aus dem Internet in Excel
Ich diesen code verwenden, um abrufen von historischen Börsenkurse für über 40-Ticker. Ich fand es hier http://www.mathfinance.cn/download-multiple-stock-quotes-from-yahoo-finance
Lädt es für etwa die Hälfte der Symbole, bevor Sie ein Run-time Error '1004' angezeigt. "Unable to open http://table.finance.yahoo.com/table.csv?s=Tickersymbol&a=11&b=21&c=1998 Die internet-Website meldet, dass der Artikel, den Sie angefordert wurde nicht gefunden (HTTP/1.0 404)
Kann ich den code ändern, damit dieser Fehler nicht passieren? Der code ist unten
Sub Get_Yahoo_finance()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Dim Ticker As String
Dim StartDate As Date
Dim EndDate As Date
Dim a, b, c, d, e, f
Dim StrURL As String
Set Sh = Worksheets("Input")
Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
For Each Cell In Rng
Ticker = Cell.Value
StartDate = Cell.Offset(0, 1).Value
EndDate = Cell.Offset(0, 2).Value
a = Format(Month(StartDate) - 1, "00") ' Month minus 1
b = Day(StartDate)
c = Year(StartDate)
d = Format(Month(EndDate) - 1, "00")
e = Day(EndDate)
f = Year(EndDate)
StrURL = "URL;http://table.finance.yahoo.com/table.csv?"
StrURL = StrURL & "s=" & Ticker & "&a=" & a & "&b=" & b
StrURL = StrURL & "&c=" & c & "&d=" & d & "&e=" & e
StrURL = StrURL & "&f=" & f & "&g=d&ignore=.csv"
If WorksheetExists(Ticker, ActiveWorkbook) Then
Application.DisplayAlerts = False
Sheets(Ticker).Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Worksheets.Add.Name = Ticker
Else
ActiveWorkbook.Worksheets.Add.Name = Ticker
End If
With ActiveSheet.QueryTables.Add(Connection:=StrURL, Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1))
Range("A2").Select
Range(Selection, Selection.End(xlDown)).NumberFormat = "d-mmm-yy"
Columns("A:F").EntireColumn.AutoFit
Next Cell
End Sub
Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function
- Sie haben, um einen Bereich auszuwählen, bevor Sie diese Funktion ausführen? Wenn ja, sind Sie bei der Auswahl leere Felder?
- nee, nicht die Auswahl, leere Felder, es scheint gerade die Zeit für einige Grund. Irgendwelche Ideen?
- Ich habe es zu arbeiten, aus der box, keine änderungen an das Skript oder irgendetwas. Ich habe es einmal und es ist fehlgeschlagen. Setzen Sie einen Haltepunkt in der query-Zeile, lud die yahoo-Adresse in meinen browser, um sicherzustellen, dass es gültig war, dann wird das Skript hat funktioniert! Verrückt.
- ja, bei mir hat es geklappt, die ersten paar mal ich lief es auch. Dann begann es zu stoppen, mit der run-time-error. Können Sie mir einen gefallen tun und mir zeigen, wo genau Sie den Haltepunkt? Vielleicht veröffentlichen Sie den code in eine neue Antwort unten, so kann ich dies als beantwortet?
Du musst angemeldet sein, um einen Kommentar abzugeben.
Kann ich nicht Ihre Methode funktioniert (ich bekomme out of memory-Fehler nach ein paar 100s-Ticker).
So, ich habe Interesse und grub ein bisschen weiter. Ich schlage einen anderen Ansatz unten, die komplexere, aber bessere Ergebnisse (ich habe die 500 Aktien des S&P in 3 Minuten (etwa 3 Sekunden für die eigentliche Aufgabe in Excel, der rest ist Anschluss /download-Zeit). Kopieren Sie einfach fügen Sie den gesamten code in ein Modul und führen Sie die
runBatch
Verfahren.EDIT: Den code unten behebt das Problem, das Sie berichtet, aber aus der Erinnerung sehr schnell. Erstellt habe ich eine andere Antwort, die ich denke, ist viel besser und robuster
Sieht es aus wie deine Abfrage ist nicht anerkannt vom server. Sie können hinzufügen, einige Fehler prüft weiterhin, ob ein solcher Fehler aufgetreten ist.
Möchten Sie vielleicht zu löschen, das Blatt, anstatt eine Fehlermeldung, oder vielleicht schicken Sie eine MsgBox statt...
Ich habe es einmal und es ist fehlgeschlagen. Setzen Sie einen Haltepunkt in der query-Zeile, lud die yahoo-Adresse in meinen browser, um sicherzustellen, dass es gültig war, dann wird das Skript gearbeitet. Ich habe auch sicher, dass es keine anderen Arbeitsblättern in das Projekt. Hier ein screenshot der VBA-editor, und wo der Haltepunkt geht:
Kleben Sie die variable in eine watch-Fenster und dann täuschen um mit, um zu sehen, was es tut. Wenn Sie kommen mit allen Anwendungen für diese ich würde gerne hören, über Sie!
Beigefügt ist eine "einfachere" Lösung mit den original-code geändert, um erneut abrufen die ticker-Daten bis zu 3-mal (wartet ein paar Sekunden zwischen den versuchen), bevor Sie schließlich eingestehen von Versagen durch die messagebox. My 2 cents 🙂