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

**irne6381** · 24/07/2019, 12h09

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 :

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
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

**irne6381** · 22/08/2019, 13h58

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 :

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
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

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

Macros et VBA Excel

Discussions similaires

Partager

Partager