'

'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 und Börsenplatz. Im Beispiel steht in Zelle C2 die ISIN 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),
'FRZ (Zertifikate Frankfurt), DBR (Deutsche Bank Indikation Rohstoffe)
'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(Isin As String, Boerse As String) As Double
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/" & Isin & "/kurs", False
XML.send
KursString = XML.responsetext
KursString = Mid(KursString, InStr(KursString, "Handelsplatz"))
If Boerse = "BER" Then TextPos = InStr(KursString, "Berlin</a>")
If Boerse = "DUS" Then TextPos = InStr(KursString, "sseldorf</a>")
If Boerse = "ETR" Then TextPos = InStr(KursString, "Xetra</a>")
If Boerse = "FRA" Then TextPos = InStr(KursString, "Frankfurt</a>")
If Boerse = "LUS" Then TextPos = InStr(KursString, "L&amp;S RT")
If Boerse = "HAM" Then TextPos = InStr(KursString, "Hamburg</a>")
If Boerse = "MUN" Then TextPos = InStr(KursString, "nchen</a>")
If Boerse = "STG" Then TextPos = InStr(KursString, "Stuttgart</a>")
If Boerse = "TRG" Then TextPos = InStr(KursString, "Tradegate</a>")
If Boerse = "QTX" Then TextPos = InStr(KursString, "Quotrix</a>")
If Boerse = "KAG" Then TextPos = InStr(KursString, "Fondsgesellschaft")
If Boerse = "FRX" Then TextPos = InStr(KursString, "FXCM")
If Boerse = "FRZ" Then TextPos = InStr(KursString, "Frankfurt Zertifikate</a>")
If Boerse = "DBR" Then TextPos = InStr(KursString, "DB Indikation Rohstoffe")

KursString = Mid(KursString, TextPos, InStr(KursString, "Geld- und Briefkurse"))
TextPos = InStr(KursString, "format=auto_blink2")
KursString = Mid(KursString, TextPos)
KursString = Mid(KursString, InStr(KursString, ">") + 1)
KursString = Left(KursString, InStr(KursString, "<") - 1)
KursString = Trim(KursString)
ArivaQuotes = CDbl(KursString)
Set XML = Nothing
Exit Function
Fehler:
    ArivaQuotes = 0
    Set XML = Nothing
End Function

Public Function ArivaPrev(Isin As String, Boerse As String) As Double
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/" & Isin & "/kurs", False
XML.send
'Do While XML.ReadyState <> 4: Sleep 50: Loop
KursString = XML.responsetext
KursString = Mid(KursString, InStr(KursString, "Handelsplatz"))
If Boerse = "BER" Then TextPos = InStr(KursString, "Berlin</a>")
If Boerse = "DUS" Then TextPos = InStr(KursString, "sseldorf</a>")
If Boerse = "ETR" Then TextPos = InStr(KursString, "Xetra</a>")
If Boerse = "FRA" Then TextPos = InStr(KursString, "Frankfurt</a>")
If Boerse = "LUS" Then TextPos = InStr(KursString, "L&amp;S RT")
If Boerse = "HAM" Then TextPos = InStr(KursString, "Hamburg</a>")
If Boerse = "MUN" Then TextPos = InStr(KursString, "nchen</a>")
If Boerse = "STG" Then TextPos = InStr(KursString, "Stuttgart</a>")
If Boerse = "TRG" Then TextPos = InStr(KursString, "Tradegate</a>")
If Boerse = "QTX" Then TextPos = InStr(KursString, "Quotrix</a>")
If Boerse = "KAG" Then TextPos = InStr(KursString, "Fondsgesellschaft")
If Boerse = "FRX" Then TextPos = InStr(KursString, "FXCM")
If Boerse = "FRZ" Then TextPos = InStr(KursString, "Frankfurt Zertifikate</a>")
If Boerse = "DBR" Then TextPos = InStr(KursString, "DB Indikation Rohstoffe")

KursString = Mid(KursString, TextPos, InStr(KursString, "Geld- und Briefkurse"))
KursString = Split(KursString, "rowspan=""1""")(5)
TextPos = 1
Do Until IsNumeric(Mid(KursString, TextPos, 1))
    TextPos = TextPos + 1
Loop
KursString = Mid(KursString, TextPos)
KursString = Left(KursString, InStr(KursString, "&") - 1)
KursString = Trim(KursString)
ArivaPrev = CDbl(KursString)
Set XML = Nothing
Exit Function
Fehler:
    ArivaPrev = 0
    Set XML = Nothing
End Function