Problème longueur d'une variable et récupération code html

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

je cherche à récupérer les présentations d'une liste de chaînes Youtube.
Pour ce faire, l'idée est de récupérer le code html de la page présentation et d'extraire ce qui se trouve entre les balises html <pre> et </pre>.
J'utilise le code suivant (les lignes en gras sont utilisées pour débuguer)
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 Dim InternetWindow As New InternetExplorer Dim html_code As String Set ws = Sheets("Feuil1") InternetWindow.Visible = False InternetWindow.Navigate (Sheets("Feuil1").Range("A1")) Do DoEvents Loop Until InternetWindow.ReadyState = READYSTATE_COMPLETE html_code = InternetWindow.Document.Body.innerHTML With New DataObject .SetText html_code .PutInClipboard End With MsgBox Len(html_code) pre_first = InStr(1, html_code, "<pre>") pre_first_offset = pre_first + 5 pre_last = InStr(1, html_code, "</pre>") len_presentation = pre_last - 1 - pre_first_offset presentation_chaine = Mid(html_code, pre_first_offset, len_presentation) Range("A2") = presentation_chaine
Problème: ma variable html_code, qui contient 110527 caractères, ne contient pas l'intégralité du code html (190 189 caractères).
D'où cela peut-il venir sachant qu'html_code est déclaré en string, qui théroiquement peut contenir 2^31 caractères.

D'avance merci.

25/07/2017, 11h30
fuine0069

ne pourrais tu pas coller ton HTML code directement dans un excel "draft"?
et ensuite manipuler ce draft et terminer par l'effacer?
25/07/2017, 11h31
ted the Ors

Qu'entends tu par un "excel draft"? Un fichier Excel temporaire?
25/07/2017, 12h03
fuine0069

oui exact
25/07/2017, 12h05
ted the Ors

Dans ce cas, je ne vois pas trop à quoi tu penses. Parce que si je copie le contenu de la variable dans le presse papier, elle est incomplète. Le problème sera le même si je copie le contenu de cette variable dans un nouveau fichier excel, non?
25/07/2017, 12h20
patricktoulon

re

bonjour
chez moi les présentation de chaine youtube ne sont pas dans des balises "<pre>" mais des divs en fait tout dépend de ta version de IE
puisque tu passe par IE ces éléments ont une classe, sert toi de leur classe
25/07/2017, 13h30
ted the Ors

J'y ai pensé mais getElementsByClassName n'est pas pris en charge
Je vais plutôt passer par l'API Google, récupérer le JSON que je parserai.
Je mettrais le code ici.
25/07/2017, 13h49
fuine0069

Citation:

Envoyé par ted the Ors

Dans ce cas, je ne vois pas trop à quoi tu penses. Parce que si je copie le contenu de la variable dans le presse papier, elle est incomplète. Le problème sera le même si je copie le contenu de cette variable dans un nouveau fichier excel, non?

Je parlais de ne pas passer par la case variable et directement étaler InternetWindow.Document.Body.innerHTML sur un draft.
As tu déjà tenté?

Sinon tu peux tenter de passer par une manip d'internet explorer pour récupérer tous les codes nécessaires.
http://qwazerty.developpez.com/tutor...-excel/#LIII-B
j'ai utilisé ca pour un projet où il y avait plusieurs occupations à définir sur une seule et même page, je cherchais la balise occupation et ensuite je prenais les éléments suivants pour les utiliser dans mon code.
25/07/2017, 14h07
patricktoulon

Citation:

Envoyé par ted the Ors

J'y ai pensé mais getElementsByClassName n'est pas pris en charge
Je vais plutôt passer par l'API Google, récupérer le JSON que je parserai.
Je mettrais le code ici.

peut tu me donner l'adresse du JSON
25/07/2017, 14h12
ted the Ors

Code:

https://www.googleapis.com/youtube/v3/channels?part=id%2C+snippet&id=ID_DE_LA_CHAINE&fields=items%2Fsnippet%2Ftitle%2C+items%2Fsnippet%2Fdescription&key={API_KEY}

En gras, les paramètres variables.

Un exemple d'id de chaînes au hasard: UC18I5IpnlYjgLRkXiyulpHg
25/07/2017, 14h25
patricktoulon

re

oui mais tu a dis que tu voulais la listes des chaines
bon je vais faire autrement je reviens plus tard
25/07/2017, 14h26
ted the Ors

Citation:

Envoyé par patricktoulon

oui mais tu a dis que tu voulais la listes des chaines
bon je vais faire autrement je reviens plus tard

La liste des chaînes, non!

Citation:

je cherche à récupérer les présentations d'une liste de chaînes Youtube.

re
je me suis amusé un peu juste avec un object microsoftxmlhttp

regarde dans le debug

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
37
38
39
40
41
42
Function code(URL)
    Set req = CreateObject("microsoft.xmlhttp")
    With req
        .Open "get", URL, False
        .setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .setRequestHeader "Accept-Language", "fr-FR"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
        .setRequestHeader "Accept-Encoding", "gzip, deflate"
        .setRequestHeader "Host", "www.youtube.com"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Connection", "Keep - Alive"
        .send
        'Debug.Print .GetAllResponseHeaders
        code = .responsetext
    End With
End Function
 
Sub test()
    Dim tablocat(100, 2)
    With CreateObject("htmlfile")
        'récupération de la listes des categories de chaines
        .body.innerhtml = code("https://www.youtube.com/channels")
        For Each elem In .all
            If elem.classname = "category-title-link" Then
                t = t + 1: tablocat(t, 0) = elem.innertext: tablocat(t, 1) = "https://www.youtube.com" & Replace(elem.href, "about:", "")
                'Debug.Print elem.innertext & "  link= https://www.youtube.com" & Replace(elem.href, "about:", "")
            End If
        Next
        For i = 1 To t
            If tablocat(i, 0) <> "" Then
                Debug.Print vbCrLf & "CATEGORIES de la chaine " & tablocat(i, 0) & vbCrLf
                .body.innerhtml = code(tablocat(i, 1))
                For Each elem In .all
                    If elem.classname = "yt-gb-shelf-hero-thumb" Then
                        'tablocat(i, 1) = tablocat(i, 1) & vbCrLf & elem.innertext: tablocat(t, 1) = "https://www.youtube.com" & Replace(elem.href, "about:", "")
                        Debug.Print "titre: " & elem.Title & "  link= https://www.youtube.com" & Replace(elem.href, "about:", "")
                    End If
                Next
            End If
        Next
    End With
End Sub

apres la présentation c'est quoi exactement?

La présentation, c'est ce qu'on trouve dans la partie "à propos" donc sous l'url de la forme https://www.youtube.com/user/user_name/about

Le problème de passer par l'html, c'est que la structure html d'une page Youtube change souvent et il arrive que les balises, les classes changent.
Mais ton code est nickel et je vais peut être l'utiliser pour récupérer l'id de la chaîne (parce que j'ai une liste de user (ce qu'on trouve dans l'url de la chaîne Youtube) qui diffère de l'id et c'est l'id qui est utilisée par les API).

Bref, un bout de code beaucoup moins classe mais qui fonctionne aussi:
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 Sub Curl_VBA_Chaine_Youtube() Dim webServiceURL As String Dim json_unparsed As String url_api_1 = "https://www.googleapis.com/youtube/v3/channels?part=id%2C+snippet&id=" id_chaine = "UC18I5IpnlYjgLRkXiyulpHg" url_api_2 = "&fields=items%2Fsnippet%2Fdescription&key=" api_key = "clé_api_communiqué_par_google" webServiceURL = url_api_1 & id_chaine & url_api_2 & api_key Set XML = CreateObject("Microsoft.XMLHTTP") XML.Open "GET", webServiceURL, False XML.send json_unparsed = XML.responseText json_description_pos_start = InStr(1, json_unparsed, "description" & Chr(34) & ":") + 13 json_description_pos_end = InStr(1, json_unparsed, "}") json_description_len = json_description_pos_end - json_description_pos_start description_chaine = Mid(json_unparsed, json_description_pos_start, json_description_len) MsgBox description_chaine End Sub
J'ai essayé de parser le json avec la méthode de RedStapler (cf: https://www.youtube.com/watch?v=CFFLRmHsEAs) mais ça ne fonctionne pas dans mon cas. Je n'ai pas trop cherché plus loin sachant que je n'ai besoin que d'un seul champ dans le json généré par l'API.

Bref, encore merci à tous et bonne fin de journée.

25/07/2017, 15h53
patricktoulon

re

comment fait on pour obtenir une cle chez Google?

tu peut envoyé sous format text le JSON obtenue

tu trouvera dans le forum nombreuse façon de parser un json en vba dont j'ai participé
25/07/2017, 16h25
ted the Ors

Pour obtenir une clé, il "suffit" d'avoir un compte Google et d'aller sur la page https://console.developers.google.com. Ensuite, tu choisis pour quel(s) service(s) Google tu souhaites utiliser la clé et c'est tout.
C'est gratuit et il y a des limitations mais elles sont très larges.
25/07/2017, 16h49
patricktoulon

re

Citation:

Le problème de passer par l'html, c'est que la structure html d'une page Youtube change souvent et il arrive que les balises, les classes changent.

rien de plus facile
au lieu de rechercher par id ou class etc tu cherche par le innertext "a propos" et tu prends le Href
25/07/2017, 16h57
patricktoulon

re

d'accords j'y suis allé et je suis connecté il me demande de créer un projet etc... ca n'en fini plus comme dans la démo en vidéo ,purée ca décourage non merci!!

surtout que pour l'exercice d'aujourd'hui je peut faire complément sans ,jusque a la présentation comprise

Je viens d'essayer d'appliquer ton code et...c'est un échec!

Je cherche à récupérer les éléments ayant pour classe "about-stats".
L'html correspondant:
Code:

1 2 3 4 5 6 7 <div class="about-metadata-stats branded-page-box-padding"> <div class="about-stats"> <span class="about-stat"><b>463 634</b> abonnés</span> <span class="about-stat"> • <b>22 963 399</b> vues</span> <br/> <span class="about-stat">Membre depuis le 7 mars 2014</span> </div>
Voilà ce que j'ai fait:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Function Code(URL) Set req = CreateObject("microsoft.xmlhttp") With req .Open "get", URL, False .setRequestHeader "Accept", "text/html, application/xhtml+xml, */*" .setRequestHeader "Accept-Language", "fr-FR" .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)" .setRequestHeader "Accept-Encoding", "gzip, deflate" .setRequestHeader "Host", "www.youtube.com" .setRequestHeader "DNT", "1" .setRequestHeader "Connection", "Keep - Alive" .send 'Debug.Print .GetAllResponseHeaders Code = .responseText End With End Function
Code:

1 2 3 4 5 6 7 8 9 10 With CreateObject("htmlfile") .body.innerHTML = Code("https://www.youtube.com/user/xChakeup") For Each elem In .all MsgBox elem.className If elem.className = "about-stat" Then element_valeur = elem.innerText MsgBox element_valeur End If Next End With
La condition du If en gras n'est jamais remplie...

Citation:

Envoyé par patricktoulon

d'accords j'y suis allé et je suis connecté il me demande de créer un projet etc... ca n'en fini plus comme dans la démo en vidéo ,purée ca décourage non merci!!

surtout que pour l'exercice d'aujourd'hui je peut faire complément sans ,jusque a la présentation comprise

:ptdr:
Oui, mais je t'assure que pour des solutions robustes et pérennes, les API sont plus indiquées que de passer par le code généré de la page. ;)

de cela j'en suis pas sur d'ailleurs sur ce forum tu trouvera des discution sur Google map il s'avere que l'api n'est pas toujours fiable

du coup je recupere non pas un json mais un fichier au format XML a la place avec une requete comme celle ci et ca fonctionne toujour aussi bien depuis 3 ans
dans ce même labs de temps l'api a changer 4 fois

bon cela dit
tiens c'est cadeau

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Function code(url)
    Set req = CreateObject("microsoft.xmlhttp")
    With req
        .Open "get", url, False
        .setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .setRequestHeader "Accept-Language", "fr-FR"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
        .setRequestHeader "Accept-Encoding", "gzip, deflate"
        .setRequestHeader "Host", "www.youtube.com"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Connection", "Keep - Alive"
        .send
        'Debug.Print .GetAllResponseHeaders
        code = .responseText
    End With
End Function
 
Sub test()
    Dim tablocat(100, 2), tablochaine(100, 6)
    With CreateObject("htmlfile")
        'récupération de la listes des categories de chaines
        .body.innerhtml = code("https://www.youtube.com/channels")
        For Each elem In .all
            If elem.classname = "category-title-link" Then
                t = t + 1: tablocat(t, 0) = elem.innertext: tablocat(t, 1) = "https://www.youtube.com" & Replace(elem.href, "about:", "")
                'Debug.Print elem.innertext & "  link= https://www.youtube.com" & Replace(elem.href, "about:", "")
            End If
        Next
        For i = 1 To 2
            If tablocat(i, 0) <> "" Then
                Debug.Print vbCrLf & "CATEGORIES de la chaine " & tablocat(i, 0) & vbCrLf
                .body.innerhtml = code(tablocat(i, 1))
                For Each elem In .all
                    If elem.classname = "yt-gb-shelf-hero-thumb" Then
                        c = c + 1
                        tablochaine(c, 1) = tablocat(i, 0)
                        tablochaine(c, 2) = elem.Title
                        tablochaine(c, 3) = "https://www.youtube.com" & Replace(elem.href, "about:", "")
                        tablochaine(c, 4) = a_propos("https://www.youtube.com" & Replace(elem.href, "about:", "") & "/about")
                        'tablocat(i, 1) = tablocat(i, 1) & vbCrLf & elem.innertext: tablocat(t, 1) = "https://www.youtube.com" & Replace(elem.href, "about:", "")
                        Debug.Print "titre: " & elem.Title & "  link= https://www.youtube.com" & Replace(elem.href, "about:", "")
                    End If
                Next
            End If
        Next
    End With
    MsgBox tablochaine(1, 1) & vbCrLf & "titre : " & tablochaine(1, 2) & vbCrLf & " a propos : " & tablochaine(1, 4)
End Sub
 
Function a_propos(url)
    With CreateObject("htmlfile")
        .body.innerhtml = code(url)
        For Each elem In .all
            If elem.tagname = "PRE" Then a_propos = elem.innertext: a_propos = elem.innertext: Exit For
        Next
    End With
End Function

regarde ton message a la fin
tu a tout!!!!! dans tablochaine(x,y)
bien sur si tu met tout les debug.print en commentaire ca accélère la cadence ;)

et la j'ai arreté a deux categorie je viens de le faire en entier (800 chaines récupérées) avec lien,lien "apropos,text et tout et tout dans tablochaines (x,y)
temps d'execution 2.27 minutes
tu veux que je te mette ca au propre avec tableau sur sheets et tout et tout

Voir 40 message(s) de cette discussion en une page