'Abruf von Börsenkursen über Google Finance:
'Nach dem Kopieren der Funktionen in ein Modul einer Excel-Datei kann die Funktion in jede beliebige Zelle wie folgt eingetragen werden:
'=gQuotesL(A2;A3) für den letzten Kurs
'=gQuotesP(A2;A3) für den Vortagesschlusskurs
'Die Funktion benötigt zwei Parameter: Börsenplatz (FRA, ETR) und Tickersymbol. Im Beispiel steht in Zelle A2 der Börsenplatz und
'in Zelle A3 das Tickersymbol des Wertpapiers.
'Leider kennt GoogleFinance z. Zt. nur Xetra (ETR) und Frankfurt (FRA) als Deutsche Börsenplätze.

Public Function gQuotesL(Boerse As String, Ticker As String) As Double
Dim TextRueckgabeString As String
Dim SuchTextPosition As Double
Dim SuchText As String
Dim CompanyId As String
Dim XML
On Error GoTo Fehler
Set XML = CreateObject("MSXML2.ServerXMLHTTP")
    XML.Open "GET", "https://finance.google.com/finance?q=" & Boerse & ":" & Ticker, False
XML.send
TextRueckgabeString = XML.responsetext
CompanyId = Mid(TextRueckgabeString, InStr(TextRueckgabeString, "setCompanyId(") + 13)
CompanyId = Left(CompanyId, InStr(CompanyId, ")") - 1)
TextRueckgabeString = Split(TextRueckgabeString, CompanyId & "_l")(1)
TextRueckgabeString = Split(TextRueckgabeString, ">")(1)
TextRueckgabeString = Left(TextRueckgabeString, InStr(TextRueckgabeString, "<") - 1)
TextRueckgabeString = Replace(TextRueckgabeString, ".", ",")
gQuotesL = CDbl(TextRueckgabeString)
'Set XML = Nothing
Exit Function
Fehler:
    gQuotesL = 0
    Set XML = Nothing
End Function

Public Function gQuotesP(Boerse As String, Ticker As String) As Double
Dim TextRueckgabeStringL As String
Dim TextRueckgabeStringP As String
Dim XML
On Error GoTo Fehler
Set XML = CreateObject("MSXML2.ServerXMLHTTP")
    XML.Open "GET", "https://finance.google.com/finance?q=" & Boerse & ":" & Ticker, False
XML.send
TextRueckgabeStringL = XML.responsetext
TextRueckgabeStringP = XML.responsetext
CompanyId = Mid(TextRueckgabeStringL, InStr(TextRueckgabeStringL, "setCompanyId") + 13)
CompanyId = Left(CompanyId, InStr(CompanyId, ")") - 1)
TextRueckgabeStringL = Split(TextRueckgabeStringL, CompanyId & "_l")(1)
TextRueckgabeStringL = Split(TextRueckgabeStringL, ">")(1)
TextRueckgabeStringL = Left(TextRueckgabeStringL, InStr(TextRueckgabeStringL, "<") - 1)
TextRueckgabeStringL = Replace(TextRueckgabeStringL, ".", ",")
TextRueckgabeStringP = Split(TextRueckgabeStringP, CompanyId & "_c")(1)
TextRueckgabeStringP = Split(TextRueckgabeStringP, ">")(1)
TextRueckgabeStringP = Left(TextRueckgabeStringP, InStr(TextRueckgabeStringP, "<") - 1)
TextRueckgabeStringP = Replace(TextRueckgabeStringP, ".", ",")
gQuotesP = CDbl(TextRueckgabeStringL - TextRueckgabeStringP)
'Set XML = Nothing
Exit Function
Fehler:
    gQuotesP = 0
    Set XML = Nothing
End Function