Récupération de tableaux sur internet avec microsoft.xmlhttp encoding caractères accentués

Option Explicit Sub testX() Dim p, I& Sheets(1).Cells.Clear p = Array("Pilier", "Talonneur", "2%E8me%20ligne", "3%E8me%20ligne", "Demi%20de%20m%EAl%E9e", "Ouvreur", "Ailier", "Centre", "Arri%E8re", "all") For I = 0 To UBound(p) getTable p(I), 1, 40 Next End Sub Sub getTable(place, debut, fin) Application.ScreenUpdating = False Dim Req As Object, url As String, Tables, T, elem 'http://www.rugbycoaching.eu/joueurs.php?poste=" & Tab_Place(place) & "&club=all&journee=all&tri=points&from=" & debut & "&to=" & fin url = "http://www.rugbycoaching.eu/joueurs.php?poste=" & place & "&club=all&journee=all&tri=points&from=1&to=40" Set Req = CreateObject("microsoft.xmlhttp") Req.Open "GET", url, False Req.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko" Req.send With CreateObject("htmlfile") .body.innerhtml = Req.responsetext Set Tables = .getelementsbytagname("TABLE") Set T = Tables(5) For Each elem In T.all If elem.tagname = "IMG" Then elem.parentelement.RemoveChild (elem) Next If .parentWindow.clipboardData.setData("Text", "<html><body>" & place & " " & T.outerhtml & "</body></html>") Then Application.ScreenUpdating = False With Sheets(1) .Activate .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select .Paste End With .parentWindow.clipboardData.clearData "Text" End If End With End Sub

Citation:

Envoyé par irne6381

Bonjour
PatrickToulon que je remercie m'avait donné la solution pour récupérer des tableaux sous internet.
rapidement c'est http://www.rugbycoaching.eu/joueurs....s&from=1&to=40
avec le poste= variable, from et to(= from + 39) variable
j'obtiens au lieu de Léo Aouf, L?Aouf et chaque joueur avec un caractère accentué dans son nom ou son prénom mets ? et "bouffe" deux caractères en plus.
j'ai récupéré le code source dans notepad ++, celui-ci est en UCS-2 LE BOM

donc questions
Peut-on quand on charge la page décréter le codage?
existe-t-il une macro vba pour encoder en utf-8 ou autres encodages avec accents
voici le bout de code que m'a donné Patrick de Toulon:

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
34
35
36
Option Explicit
Sub testX()
    Dim p, I&
   Sheets(1).Cells.Clear
    p = Array("Pilier", "Talonneur", "2%E8me%20ligne", "3%E8me%20ligne", "Demi%20de%20m%EAl%E9e", "Ouvreur", "Ailier", "Centre", "Arri%E8re", "all")
    For I = 0 To UBound(p)
        getTable p(I), 1, 40
    Next
End Sub
Sub getTable(place, debut, fin)
    Application.ScreenUpdating = False
    Dim Req As Object, url As String, Tables, T, elem
    'http://www.rugbycoaching.eu/joueurs.php?poste=" & Tab_Place(place) & "&club=all&journee=all&tri=points&from=" & debut & "&to=" & fin
    url = "http://www.rugbycoaching.eu/joueurs.php?poste=" & place & "&club=all&journee=all&tri=points&from=1&to=40"
    Set Req = CreateObject("microsoft.xmlhttp")
    Req.Open "GET", url, False
    Req.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
    Req.send
    With CreateObject("htmlfile")
        .body.innerhtml = Req.responsetext
        Set Tables = .getelementsbytagname("TABLE")
        Set T = Tables(5)
        For Each elem In T.all
            If elem.tagname = "IMG" Then elem.parentelement.RemoveChild (elem)
        Next
        If .parentWindow.clipboardData.setData("Text", "<html><body><font color=#ff0000 size=6><strong>" & place & "</strong></font><br>" & T.outerhtml & "</body></html>") Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub