Importation Page web sur excel via VBA

Version imprimable

Bonjour,
Je suis encore débutant en VBA
Je travaille depuis un certain temps à automatiser l'importation de plusieurs pages web sur Excel. mais je me heurte à des difficultés.
La procédure fonctionne mais il arrive souvent qu'il apparaisse l'erreur "Délai de connexion dépassé". Comment faire pour y remédier?
Par ailleurs je souhaiterais importer les codes sources des pages web sur Excel, à partir de quoi je pourrais accéder aux données des liens sélectionnés.
Et Enfin, je trouve l'exécution de la procédure un peu lente (environ 15 mn pour environ 6000 lignes traitées).
Pourriez vous m'aider à trouver des solutions?
ci - dessous la procédure d'importation que j'utilise.
Merci d'avance.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 Sub req_web_Chev(Chaine As String) Application.Calculation = xlCalculationManual Application.ScreenUpdating = False On Error GoTo Erreurs1 With Workbooks("Etat Préparatoire Courses").Worksheets("Perf Chev") With .QueryTables.Add(Connection:= _ "URL;" & Chaine, _ Destination:=.Range("B1048576").End(xlUp).Offset(1, 0)) .BackgroundQuery = True .TablesOnlyFromHTML = True .Refresh BackgroundQuery:=False .SaveData = True End With End With Exit Sub Erreurs1: Workbooks("Etat Préparatoire Courses").Worksheets("Perf Chev").UsedRange.ClearContents Call Importations_Chev Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic

30/05/2018, 10h26
patricktoulon

re

re
bonjour est ilpossible d'avoir cette url ???
30/05/2018, 16h51
knagni

1 pièce(s) jointe(s)

Exemple URL

Exemple d'Url

Pièce jointe 384643

Merci.
30/05/2018, 18h56
patricktoulon

re

re
d'accords encore un nouveau sebphito
si tu fait une recherche avec ce pseudo tu trouvera plein de chose sur geny et autre site de turf

cela dit 6000 requetes il faut pas t'etonner du temps d'execution surtout avec querytable d'excel
perso je prefere le faire moi meme en vba la requete
je te fait un exemple donne moi 5 minutes juste pour verifier si la structure des page genycourse est toujour obstensible par requetes

apres plutot que de recupérer tout le code source on peut récupérer juste ce dont tu a besoins

aussi si tu te donne la peine de chercher marcl propose un exemple de multithread (requetes) dans les contributions

en bref tu a ce que tu cherche 300 fois dans le forum
je reviens ....+

2 pièce(s) jointe(s)

re
bon voila un 1er jet de l'idée de base
regarde ce que je recupere dans le sheets resultat que j'ai ajouté

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub testrequete()
    With Sheets("resultat"): .Activate: .Cells.Clear: End With
    For i = 2 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        requete Sheets(1).Cells(i, 1).Value
    Next
    deleteshap
    MsgBox "terminé!!"
End Sub
Sub requete(url)
    Dim req
    Set req = CreateObject("microsoft.xmlhttp")
    req.Open "POST", url, False
    req.send
    With CreateObject("htmlfile")
        .body.innerhtml = req.responsetext
        Set tables = .getelementsbytagname("TABLE")
        texte = "<style>TD{border:1px solid black;}</style>" & vbCrLf & "<font color=red><strong>" & .getelementsbytagname("H1")(0).innertext & "</strong><br> musique :" & .getelementsbytagname("H3")(0).innertext & "</font>" & tables(1).outerhtml & tables(3).outerhtml
        If .parentWindow.clipboardData.setData("Text", texte) Then
            Application.ScreenUpdating = False
            With Sheets("resultat")
                .Cells(Rows.Count, 1).End(xlUp).Offset(3, 0).Select
                .Paste
            .Columns("A:z").AutoFit
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub
Sub deleteshap()
    For Each shap In Sheets(2).Shapes
        shap.Delete
    Next
End Sub

regarde le gif jusqu'au bout

Pièce jointe 384707
teste ce fichier
;)

re
si tu veux le lien de la course du jour (quinté)voici
une petite sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test_recuplinkquinteToday()
    Dim req
    Set req = CreateObject("microsoft.xmlhttp")
    req.Open "POST", "http://www.geny.com/reunions-courses-pmu?" & Format(Date, "yyyy-mm-dd"), False
    req.send
    Debug.Print
    With CreateObject("htmlfile")
        .body.innerhtml = req.responsetext
        For Each elem In .getelementsbytagname("a")
            If elem.href Like "*centpourcent-quinte*" Then Debug.Print Replace(elem.href, "about", "http://www.geny.com")
        Next
    End With
End Sub

parti de ce lien tu peux recupérer les liens des chevaux dans le tableau a droite
;)
tag ton post resolu si tu a ce qu'il te faut comme ca j'arrete le suivi

31/05/2018, 10h41
knagni

Merci infiniment.
31/05/2018, 11h39
patricktoulon

re

re
tag resolu alors ;)
03/06/2018, 07h42
knagni

1 pièce(s) jointe(s)

Message d'erreur

Bonjour,
Désolé pour le temps mis, mais j'essayais de comprendre le code.
Lors de l'exécution, je me heurte à un message d'erreur

Citation:

Variable objet ou de bloc with non définie

à la ligne 17 ci - dessous:

Code:

texte = "<style>TD{border:1px solid black;}</style>" & vbCrLf & "<font color=red><strong>" & .getelementsbytagname("H1")(0).innertext & "</strong><br> musique :" & .getelementsbytagname("H3")(0).innertext & "</font>" & tables(1).outerhtml & tables(3).outerhtml

Par ailleurs, j'ai essayé de l'adapter à mon besoin. Je joins ici le code modifié. Merci d'apprécier et éventuellement de m'orienter pour les corrections à y apporter.

Pièce jointe 385530

Merci d'avance.
03/06/2018, 09h54
patricktoulon

re

re
c'est normal les page cheval, entraineur et jokey ne sont pas les memes
03/06/2018, 12h10
patricktoulon

1 pièce(s) jointe(s)

re

test
tu peux faire que les chevaux ou jockey ou enrtraineur OU!!! la total d'un coup en lancant mise ajour globale
;)
27/11/2019, 00h46
starwaso

HELP

Bonjour, :)
Peut-on avoir le fichier Excel dont vous parler ?
Merci
07/01/2020, 00h15
starwaso

Bonsoir,
toujours a la recherche du fichier, ... en MP c'est discret merci ;)

Bonne nuit