Kurse über Euch in VBA beziehen

[Pflichtfeld]

Moin,
Nachdem Ihr leider keine jahresbezogene Rendite einbauen wollt hab ich mir ein access-Programm geschrieben zur Verwaltung meiner Aktien.
Alf kann ja aktienkurse über comdirect aktualisieren.
Steht dieser Weg auch mir als Alf-Nutzer offen? Kann auch ich diese Anfrage senden mittels vba? Gibts hier evtl. eine API-Schnittstelle?

[AZ29D2]

comdirect hat wohl keine API, die Du ansprechen kannst.

Versuch mal diese Datenquelle:

Code: Alles auswählen

https://query1.finance.yahoo.com/v7/finance/quote?symbols=SAP.DE

[Pflichtfeld]

Vielen Dank, ich hatte das auch schon versucht, aber offenbar muss man da ein Abo haben? Mir mir wurde gar nix zurückgegeben, bei Deinem Link bekomme ich Fehler: "User is unable to access this feature - https://bit.ly/yahoo-finance-api-feedback"

Habe es nun per screenscraping bei Onvista hinbekommen. Mal sehen, ob das pflegeaufwändig sein wird...

Code: Alles auswählen

'Dieses Sub arbeitet mit screenscraping.
'http.responseText ist der html-code von Onvista und sehr lang.
'um den code anzusehen sollte man den nicht kopieren, passt nicht ins debug fenster,
'sondern: in Dateien schreiben, s.u.
'Kommt man nicht weiter, dann öffnet man die url von onvista im Firefox, rechtsclick
'untersuchen. dann kann man im code durchclicken und sehen wie und wo der Kurs genau steht.
'momentan ist einmalig im responsetext das "text-4xl" vor dem Wert.
'text-4xl max-md:text-2xl font-bold" value="26.26">26,26<span >
'auch der erste Treffer für text-2xl würde hinhauen. beim 2. steht dann die tendenz...
'Die wichtigen Werte stehen in der Ecke, wo die ersten >Eur< stehen
Public Function getOnvistaKurs(strWKN As String) As Double
    Dim http As Object
    Dim response As String
    Dim startPos As Long, endPos As Long
    Dim kursRaw As String
    Dim debugMode As Boolean
    Dim fileroot As String
    Dim strURL As String
    
    debugMode = False        ' Bei Bedarf auf True setzen
    fileroot = "D:\temp\Onvista_Response-" 'Bei Bedarf anpassen
    
    ' Die URL mit Zeitstempel (Timer) gegen den Cache
    strURL = "https://www.onvista.de/suche/?searchValue=" & strWKN & "&nocache=" & Timer
    
    On Error Resume Next
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", strURL, False
    
    ' Nur ein Header für den User-Agent (der modernere)
    http.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/120.0.0.0 Safari/537.36"

    ' Cache-Umgehung erzwingen
    http.setRequestHeader "Cache-Control", "no-cache, max-age=0"
    http.setRequestHeader "Pragma", "no-cache"
    http.setRequestHeader "If-Modified-Since", "Mon, 01 Jan 1990 00:00:00 GMT"
    
    http.Send
    
    If http.Status = 200 Then
        response = http.responseText
        
        ' Debug-Ausgabe
        If debugMode Then
            Dim fso As Object, oFile As Object
            Set fso = CreateObject("Scripting.FileSystemObject")
            ' HTML-Datei schreiben
            Set oFile = fso.CreateTextFile(fileroot & strWKN & ".html", True, True)
            oFile.Write response
            oFile.Close
        End If
        
        ' 1. Suche den einmaligen Anker (text-4xl)
        startPos = InStr(response, "text-4xl")
        
        If startPos > 0 Then
            ' 2. Suche das nächste 'value="' nach diesem Anker
            startPos = InStr(startPos, response, "value=""")
            
            If startPos > 0 Then
                startPos = startPos + 7 ' Hinter value=" springen
                endPos = InStr(startPos, response, """")
                
                ' 3. Wert extrahieren (z.B. "26.26")
                kursRaw = Mid(response, startPos, endPos - startPos)
                
                ' Umwandlung in Zahl
                getOnvistaKurs = Val(kursRaw)
            End If
        End If
    End If
    
    Set http = Nothing
    On Error GoTo 0
End Function