Resultaten downloaden van euromillions

Status
Niet open voor verdere reacties.
V

Valentin

Gebruiker
Lid geworden
14 feb 2009
Berichten
80
In het verleden gebruikte ik deze twee coderegels (onderdeel van een veel groter macro) om de resultaten van euromillions te downloaden naar het bestand "Euromillions controle".
Code: 
Sheets("GameData").Select
ActiveSheet.QueryTables.Add("URL;http://www.nationale-loterij.be/Controls/Draw/DownloadResults.ashx?productId=e07ce0de-9072-436f-b6ec-9a7e9475fa6f&StartDate=" & Sheets(1).Cells(4, 2).Value & "&EndDate=" & Year(Now()) & "1231&ExportData=True", Destination:=Range("A1")).Refresh True

Sheets("FinancialData").Select
ActiveSheet.QueryTables.Add("URL;http://www.nationale-loterij.be/Controls/Draw/DownloadResults.ashx?productId=e07ce0de-9072-436f-b6ec-9a7e9475fa6f&StartDate=" & Sheets(1).Cells(4, 2).Value & "&EndDate=" & Year(Now()) & "1231&ExportData=false", Destination:=Range("A1")).Refresh True

Het eerste bestand = EuroMillionsGameData.cvs
Het tweede bestand = EuroMillionsFinancialData.cvs

Onlangs heeft men de website totaal vernieuwd en werkt mijn code natuurlijk niet meer.
Als ik dan op de website ga zoeken naar de broncode van de betreffende webpagina vind ik de betreffende url's niet terug.
Wel heb ik gemerkt dat de website nu gebruik maakt van javascript, maar daar ken ik niets van.
Mijn vraag is of het toch nog mogelijk is met een macro om beide bestanden toch te downloaden.

Het betreffende url van de pagina is http://www.nationale-loterij.be/nl/onze-spelen/euro-millions/resultaten
 
Laatst bewerkt:
Code: 
[SIZE=1]Option Explicit

Public Sub Nationale_Loterij_Be_EuroMillions()
    Dim objScriptControl As Object
    Dim strDateLast As String
    Dim strResponseText As String
    Dim strURL As String
        Worksheets("Blad1").Range("A1:G1").Value = Array("E", "E", "E", "E", "E", "E", "E")
        strURL = "http://www.nationale-loterij.be/drawapi/draw/"
        Set objScriptControl = CreateObject("ScriptControl")
        objScriptControl.Language = "JScript"
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", strURL & "getavailabledatesforbrand?brand=EuroMillions", False    'am_2014"
            .Send
            Do
                DoEvents
            Loop While .ReadyState <> 4
            Application.Wait DateAdd("s", 1, Now)
            strResponseText = .ResponseText
            If objScriptControl.Eval("(" + strResponseText + ")").Succeeded Then
                strDateLast = Split(objScriptControl.Eval("(" + strResponseText + ")").Data, ",")(0)
                .Open "GET", strURL & "getdraw?drawdate=" & strDateLast & ".000Z&brand=EuroMillions&language=nl-BE", False
                .Send
                Do
                    DoEvents
                Loop While .ReadyState <> 4
                Application.Wait DateAdd("s", 1, Now)
                strResponseText = .ResponseText
                If objScriptControl.Eval("(" + strResponseText + ")").Succeeded Then
                    Worksheets("Blad1").Range("A1:G1").Value = Split(objScriptControl.Eval("(" + strResponseText + ")").Data.Draw.Results, ",")
                End If
            End If
        End With
        Set objScriptControl = Nothing
End Sub[/SIZE]
Bron: http://www.worksheet.nl/forumexcel/showthread.php?t=71524 bericht#30 en eventueel bericht#34
 
Dit komt al aardig in de buurt van wat ik bekomen wil, echter wil trekkingsdatum aanpassen met celverwijzing en wil ook de financiele resultaten behorend bij die datum downloaden.
 
@alpha

Voor voor zover ik kan nagaan, wacht deze methode met de uitvoering van de macro tot alle gegevens van de webplek geplukt zijn.
De DoEvents en application.wait zijn, - in tegenstelling tot wanneer je van de bibliotheek van internet explorer gebruik maakt - niet nodig.

Dus:

Code: 
Public Sub M_snb()
  strURL = "http://www.nationale-loterij.be/drawapi/draw/"
    
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", strURL & "getavailabledatesforbrand?brand=EuroMillions", False    'am_2014"
    .Send

    c00 = .ResponseText
    If InStr(Left(c00, 16), "Succeeded") Then
      c01 = Replace(Split(Split(c00, ",")(2), "[""")(1), Chr(34), "")
             
      .Open "GET", strURL & "getdraw?drawdate=" & c01 & ".000Z&brand=EuroMillions&language=nl-BE", False
      .Send
            
      c02 = .ResponseText
      Sheets(1).Range("A1:F1").Value = Filter(Filter(Split(Join(Filter(Split(c02, ","), "Number"), ":") & ":" & Join(Filter(Split(c02, ","), "Star"), ":"), ":"), "Number", False), "Star", False)
    End If
  End With
End Sub
 
Laatst bewerkt:
Dank voor deze andere code, maar dat is niet wat ik zoek.
Het is nl zo dat de persoon die met dit bestand werkt niet altijd de laatste trekking moet controleren (wegens job niet altijd toegang tot internet).
Hij controleert dan verschillende trekkingen achter elkaar waarbij de winst automatisch terug verrekend wordt voor de spelers ( zie afbeelding) en ook niet elke trekking wordt gespeeld
em.png

Bij de oude macro werden de getallen van de laatste 25 trekkingen gedownload en de financiële resultaten van deze trekkingen, en net dat had ik graag terug verkregen
 
Laatst bewerkt:
Dan zul je code een beetje moeten aanpassen.
 
Heb de code van Alphamax als volgt aangepast.
Code: 
Public Sub Nationale_Loterij_Be_EuroMillions()
    Dim objScriptControl As Object
    Dim strDateLast As String
    Dim strResponseText As String
    Dim strURL As String
    Dim Datum As String

        Worksheets("Blad1").Range("A1:G1").ClearContents
        Worksheets("Blad1").Range("A1:G1").Value = Array("E", "E", "E", "E", "E", "E", "E")
        strURL = "http://www.nationale-loterij.be/drawapi/draw/"
        Set objScriptControl = CreateObject("ScriptControl")
        objScriptControl.Language = "JScript"
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", strURL & "getavailabledatesforbrand?brand=EuroMillions", False    'am_2014"
            .Send
            Do
                DoEvents
            Loop While .ReadyState <> 4
            Application.Wait DateAdd("s", 1, Now)
            strResponseText = .ResponseText
            If objScriptControl.Eval("(" + strResponseText + ")").Succeeded Then
                strDateLast = Split(objScriptControl.Eval("(" + strResponseText + ")").Data, ",")(0)
                
            
        Datum = Format(Sheets(2).Range("O1").Value, "yyyy - mm - dd") & Right(strDateLast, 9) 'Sheets(2).Range("O1")= Keuzelijst
                
                .Open "GET", strURL & "getdraw?drawdate=" & D & ".000Z&brand=EuroMillions&language=nl-BE", False
                .Send
                Do
                    DoEvents
                Loop While .ReadyState <> 4
                Application.Wait DateAdd("s", 1, Now)
                strResponseText = .ResponseText
                If objScriptControl.Eval("(" + strResponseText + ")").Succeeded Then
                    Worksheets("Blad1").Range("A1:G1").Value = Split(objScriptControl.Eval("(" + strResponseText + ")").Data.Draw.Results, ",")
                End If
            End If
        End With
            Set objScriptControl = Nothing
End Sub

Nu nog de financiële data behorend bij de datum downloaden.
Enige hulp is welkom
 
Laatst bewerkt:
Heb code als volgt aangepast:
Code: 
If objScriptControl.Eval("(" + strResponseText + ")").Succeeded Then
                    Sheets("Results").Range("A1").Value = strResponseText

Vervolgens text to columns, en dan heb ik alle resultaten
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan