Attribute VB_Name = "F_aktuelleLottozahlen"
Option Explicit

Function aktuelleLottozahlen(ByVal Spieltag As String, _
                             Optional ByVal Debugging As Boolean) As Variant

Const RC1 As Integer = 1
Const RC2 As Integer = 2
Const RC3 As Integer = 3
Const RC4 As Integer = 4
Const RC5 As Integer = 5
Const RC6 As Integer = 6

Const LS1 As String = ">Ergebnisse vom <span>"
Const LS2 As String = ", den "
Const LS3 As String = "</span>"

Const Editor   As String = "NotePad.exe"

Dim RIndex   As Integer

Dim FPos1    As Long
Dim FPos2    As Long
Dim TempNum  As Long

Dim ObjHTTP  As Object

Dim LS       As String
Dim ScanData As String
Dim TagName  As String
Dim TextFile As String
Dim URLText  As String

Dim LWar     As Variant
Dim Work     As Variant

Dim Result() As Variant

Dim LottoURL As String

ReDim Result(0 To 0, 1 To 2)
If Not IsDate(Spieltag) Then
   Result(0, 1) = RC1
   If Debugging Then Debug.Print Spieltag & " ist kein gültiges Datum"
   GoTo FuncExit
End If
TagName = WeekdayName(Weekday(Spieltag, vbUseSystem))
Select Case TagName
       Case "Samstag", "Mittwoch"
       Case Else
            Result(0, 1) = RC2
            If Debugging Then Debug.Print TagName & " ist kein gültiger Wochentag"
            GoTo FuncExit
End Select
LottoURL = "https://www.westlotto.de/lotto-6aus49/gewinnzahlen/gewinnzahlen.html"
Set ObjHTTP = CreateObject("MSXML2.XMLHTTP")
With ObjHTTP
     .Open "GET", LottoURL, False
     Debug.Print Err.Number
     If Err.Number <> 0 Then
        Result(0, 1) = RC3
        Result(0, 2) = LottoURL
        GoTo FuncExit
     End If
     .Send
      While Not .ReadyState = 4
            DoEvents
      Wend
      URLText = StrConv(.ResponseBody, vbUnicode)
End With
Set ObjHTTP = Nothing
LS = LS1 & TagName & LS2 & Spieltag & LS3
FPos1 = InStr(URLText, LS1 & TagName & LS2 & Spieltag & LS3)
If FPos1 = 0 Then
   Result(0, 1) = RC4
   Result(0, 2) = LottoURL
   If Debugging Then GoTo SetFile
   GoTo FuncExit
End If
FPos2 = InStr(Mid(URLText, FPos1), "<p class=""heading-h5"">Gezogene Reihenfolge</p>")
Work = Split(Mid(URLText, FPos1, FPos2), "class=""polygon-label"">")
If UBound(Work) <> 7 Then
   Stop
End If
ReDim Result(1 To 7)
For TempNum = 1 To UBound(Work)
    RIndex = RIndex + 1
    Result(RIndex) = Replace(Mid(Work(TempNum), 1, 2), "<", "")
    If TempNum = 7 Then Exit For
Next TempNum
GoTo FuncExit

SetFile:
TextFile = Environ("TEMP")
If Right(TextFile, 1) <> "\" Then TextFile = TextFile & "\"
TextFile = TextFile & Format(Now, "dd.mm.yyyy hh.mm.ss.txt")
TempNum = FreeFile
Open TextFile For Output As #TempNum
Print #TempNum, URLText
Close #TempNum
With CreateObject("Wscript.Shell")
     .Run """" & Editor & """ """ & TextFile & """", 5
End With

FuncExit:
aktuelleLottozahlen = Result

End Function

Sub LottoAktuell()

Dim Loop1  As Integer

Dim LMsg   As String

Dim Zahlen As Variant

Zahlen = aktuelleLottozahlen("2405.2025", Debugging:=False)
Debug.Print Zahlen(0, 1); Zahlen(0, 2)
Zahlen = aktuelleLottozahlen("25.05.2025", Debugging:=False)
Debug.Print Zahlen(0, 1); Zahlen(0, 2)
Zahlen = aktuelleLottozahlen("17.05.2025", Debugging:=False)
Debug.Print Zahlen(0, 1); Zahlen(0, 2)
Zahlen = aktuelleLottozahlen("24.05.2025", Debugging:=True)
Debug.Print Zahlen(0, 1); Zahlen(0, 2)

'nachfolgends Datum anpassen

Zahlen = aktuelleLottozahlen("28.05.2025", Debugging:=True)
If UBound(Zahlen) = 7 Then
   LMsg = "die Gewinnzahlen lauten:  "
   For Loop1 = 1 To 6
       LMsg = LMsg & Zahlen(Loop1) & ", "
   Next Loop1
   LMsg = LMsg & " Superzahl = " & Zahlen(7)
   MsgBox LMsg
End If

End Sub