Aktienkurse updaten
18.09.2007 20:05:52
chris
Kann mir bitte wer helfen. Ich habe diesen Code hier gefunden und wollte damit die Aktien der Wr. Börse in eine Ecxel Datei übernehmen. Ich habe zu diesem Zweck die HTTP-Nr. auf die Seite der Wr. Börse geändert. Nun kommt immer eine Fehlermeldung. Kann man das irgendwie umgehen, oder kann man aus diesen Seiten keine Kurse auf Excel reinholen.
Danke für eure Antwort
chris
1. Code
Sub Boerse()
' Makro2 Makro
' Makro am 05.07.2007 von Andreas Rost aufgezeichnet
With Sheets("Import").Range("A1").QueryTable
.Connection = _
" _
URL;http://www.boerse-online.de/tools/boerse/kurse_indizes.htm?&s=846900&l=276&b=9"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' Auslesen
For i = 2 To 20
Cells(i, 2) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
10)
Cells(i, 3) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(1, _
10)
Cells(i, 4) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
2)
Cells(i, 5) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
6)
Cells(i, 6) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(1, _
6)
Next i
End Sub
-----------------------------------------------------------------------------------------------------
Geänderter Code: HTTP Änderung
Sub Boerse()
' Makro2 Makro
' Makro am 05.07.2007 von Andreas Rost aufgezeichnet
With Sheets("Import").Range("A1").QueryTable
.Connection = _
"URL; _
http://kurse.wienerborse.at/teledata_php/prices/dispatch_list.php?TYPE=P"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' Auslesen
For i = 2 To 20
Cells(i, 2) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
10)
Cells(i, 3) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(1, _
10)
Cells(i, 4) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
2)
Cells(i, 5) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(0, _
6)
Cells(i, 6) = Sheets("Import").Range("D:D").Find(Cells(i, 1), LookIn:=xlValues).Offset(1, _
6)
Next i
End Sub