Bonjour le forum ,
J'ai un problème au niveau de mon code vba ,ce code permet la récupération d'informations sur le web , mais je rencontre un problème avec une donnée concernant le format date donc après plusieurs essais de modifications que j'ai vu sur le net concernant les dates , je n'ai trouvé aucune solution donc je viens sollicité l' aide du forum.
Merci d'avance ,
Nico.
(Je vous met le code VBA en entier sachant que mon problème se situe tout à la fin ). ou même le fichier si vous le souhaitez pour que cela soit plus clair?

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Sub Traitement()
Dim vUrl As String
Dim D As String, NumCourse As String
    With Sheets("Accueil")
        D = .Range("E2").Text
        NumCourse = .ComboBox1.Text
    End With
    If Not IsNumeric(NumCourse) Then Exit Sub
    'URL de départ
    vUrl = "http://www.pmu.fr/pmu/servlet/pmu.web.servlet.www.infos.PerformancesDetaillesServlet?dd=" _
            & D & "&idc=" & NumCourse & "&np=1&ppd=0"
    'Traiter
    RecupChevaux vUrl
End Sub
 
Private Sub RecupChevaux(ByVal vUrl As String)
Dim IE As InternetExplorer
Dim O As Object, OI As Object, OIS As Object
Dim L As Long
 
    'Ouvre la page web dans IE de façon invisible
    Set IE = CreateObject("internetExplorer.Application")
    IE.Visible = False
    'RAZ de la feuille
    ActiveSheet.Cells.Delete
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'Boucle sur l'ensemble des partants
    Do
        If vUrl = "" Then
            'Bouton "Suivant" sur la page Web ?
            For Each OI In IE.Document.Links
                If OI.Title = "Suivant" Then
                    vUrl = OI.href
                End If
            Next OI
        End If
        If vUrl = "" Then Exit Do   'Sortir à la fin
        'Ouvrir la page Web
        IE.Navigate vUrl
        Do Until IE.ReadyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        'Détermine première ligne libre
        L = Cells(Rows.Count, 1).End(xlUp).Row + 3
        'Récup Nom du partant
        Set O = IE.Document.getElementsByTagName("H1")
        For Each OI In O
            L = L + 1
            With Cells(L, 1)
                .Value = OI.innerText
                .Font.Bold = True
                Application.StatusBar = .Value
            End With
        Next OI
        'Récup Détail du partant
        Set O = IE.Document.getElementsByTagName("P")
        For Each OI In O
            If OI.innerText <> " Retour à l'accueil de pmu.fr" Then
                Set OIS = OI.getElementsByTagName("span")
                L = L + 1
                With Cells(L, 1)
                    .Value = OIS.Item(0).innerText
                End With
                With Cells(L, 2)
                    .Value = OIS.Item(1).innerText
                End With
            End If
        Next OI
        L = L + 1
        Cells(L, 1) = "Gains 6 dernières courses"
        Cells(L, 2).Value = RecupPlusDetails(L, vUrl)
        vUrl = ""
    Loop
    Columns(1).AutoFit
    ActiveSheet.UsedRange.HorizontalAlignment = xlLeft
    Application.ScreenUpdating = True
    'Fermer IE
    IE.Quit
    Set IE = Nothing
    Application.StatusBar = False
End Sub
 
Private Function RecupPlusDetails(Lign As Long, vUrl As String) As String
Dim T As String
Dim L As Byte
    With Sheets("Tempo")
        .Cells.Delete
        With .QueryTables.Add(Connection:="URL;" & vUrl, Destination:=.Cells(1, 1))
            .Name = "LaRequete"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1"
            .WebFormatting = xlWebFormattingNone ' xlWebFormattingAll
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = True
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
            .Delete
        End With
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 3).Value) & "-" 'Recup Allocation
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 6).Value) & "-" ' recup Gains
        Next L
        RecupPlusDetails = Left(T, Len(T) - 2)
        For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 2, 1).Value) & "-" ' Recup Nb Partants
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
        [B]For L = 1 To 6
            T = T & Val(.Cells(L * 3 + 1, 1).Value) & "-" ' >>>>> Recup Date derniére course ( probléme) <<<<<<<<<<<<
        Next L
        RecupPlusDetails = Left(T, Len(T) - 1)
    End With
End Function