'Abruf von Börsenkursen über Ariva: 'Nach dem Kopieren der Funktionen in ein Modul einer Excel-Datei, kann die Funktion in jede beliebige 'Zelle wie folgt eingetragen werden: '=ArivaQuotes(C2;"FRA") 'Die Funktion benötigt zwei Parameter: ISIN oder WKN und Börsenplatz. Im Beispiel steht in Zelle C2 die ' ISIN/WKN des Wertpapiers, Parameter 2 gibt den Börsenplatz an. 'Gültige Börsenplätze sind: BER, DUS, ETR, FRA, LUS (Lang&Schwarz), HAM, MUN, STG, TRG (Tradegate), 'QTX (Quotrix), KAG (Fondsgesellschaft, FRX (Forex). 'Die Aktualisierung der Kurse funktioniert nicht über Taste F9, sondern kann nur durch ein Makro 'gestartet werden z.B. aufgerufen durch das Anklicken einer Befehlsschaltfläche (ActiveX-Steuerelement): 'Private Sub CommandButton1_Click() 'Application.CalculateFull 'End Sub Public Function ArivaQuotes(WKNIsin As String, Boerse As String) As Double Dim Umleitung As String Dim KursString As String Dim TextPos As Double Dim XML On Error GoTo Fehler Set XML = CreateObject("MSXML2.ServerXMLHTTP") XML.Open "GET", "https://www.ariva.de/" & WKNIsin & "/kurs", False XML.send KursString = XML.responsetext If Boerse = "BER" Then TextPos = InStr(KursString, "Berlin") If Boerse = "DUS" Then TextPos = InStr(KursString, "sseldorf") If Boerse = "ETR" Then TextPos = InStr(KursString, "Xetra") If Boerse = "FRA" Then TextPos = InStr(KursString, "Frankfurt") If Boerse = "LUS" Then TextPos = InStr(KursString, "L&S RT") If Boerse = "HAM" Then TextPos = InStr(KursString, "Hamburg") If Boerse = "MUN" Then TextPos = InStr(KursString, "nchen") If Boerse = "STG" Then TextPos = InStr(KursString, "Stuttgart") If Boerse = "TRG" Then TextPos = InStr(KursString, "Tradegate") If Boerse = "QTX" Then TextPos = InStr(KursString, "Quotrix") If Boerse = "KAG" Then TextPos = InStr(KursString, "Fondsgesellschaft") If Boerse = "FRX" Then TextPos = InStr(KursString, "FXCM") KursString = Mid(KursString, TextPos + 4) TextPos = InStr(KursString, "FXCM") End If KursString = Mid(KursString, TextPos) TextPos = InStr(KursString, "format=auto") KursString = Mid(KursString, TextPos + 14) If Mid(KursString, 15, 3) = "new" Then TextPos = InStr(KursString, ">") KursString = Mid(KursString, TextPos + 1) End If TextPos = InStr(KursString, "<") KursString = Left(KursString, TextPos - 1) ArivaQuotes = CDbl(KursString) Set XML = Nothing Exit Function Fehler: ArivaQuotes = 0 Set XML = Nothing End Function