'
Option Explicit
'
Function parseYahoo(strSymbol As String, strKennzahl As String, strModul As String) As Variant
Dim objJson As Object
Dim strResponse As String
Dim objXML As Object
Dim strZeichen As String

Set objXML = CreateObject("MSXML2.ServerXMLHTTP")
    objXML.Open "GET", "https://query1.finance.yahoo.com/v10/finance/quoteSummary/" & strSymbol & "?modules=" & strModul, False
objXML.send

strResponse = objXML.responsetext
strResponse = Mid(strResponse, 25 + InStr(Mid(strResponse, 25), ":{"))
strResponse = Left(strResponse, Len(strResponse) - 1)
Set objJson = JsonConverter.ParseJson(strResponse)
On Error Resume Next
parseYahoo = objJson(strKennzahl)
If parseYahoo = "" Then parseYahoo = objJson(strKennzahl)("fmt")
If parseYahoo = "" Then parseYahoo = objJson(strKennzahl)("raw")
If parseYahoo = "" Then parseYahoo = ""
On Error GoTo 0
If IsNumeric(parseYahoo) And parseYahoo <> "" Then
    If InStr(parseYahoo, ".") Then
        If InStr(parseYahoo, ",") Then parseYahoo = Replace(parseYahoo, ",", "")
        parseYahoo = CDbl(Replace(parseYahoo, ".", ","))
    End If
    If (InStr(strKennzahl, "Time") Or InStr(strKennzahl, "Date")) And InStr(strKennzahl, "full") = 0 Then
        If Date >= DateSerial(Year(Date), 4, 0) And Date <= DateSerial(Year(Date), 11, 0) - Weekday(DateSerial(Year(Date), 11, 0)) + 1 Then
            parseYahoo = parseYahoo + 7200
            Else: parseYahoo = parseYahoo + 3600
        End If
        parseYahoo = (parseYahoo / 86400) + 25569
        If InStr(strKennzahl, "MarketTime") Then
            parseYahoo = format(parseYahoo, "hh:mm")
        End If
        If InStr(parseYahoo, ":") = 0 Then
            parseYahoo = format(parseYahoo, "dd.mm.yyyy")
        End If
    End If
End If