Copie de données Internet (Problème de code)

[Nonno 94]

Bonjour le Forum,

ne parvenant pas à modifier un code qui fonctionne pour copier certaines données dans des pages Internet mais pas pour en copier d'autres, je viens demander votre aide pour me dire quelle modification lui apporter pour qu'il accepte de copier ces données.

L'adresse de la page Internet est la suivante :

Cours AB SCIENCE | AB | Cotation Bourse Paris - Les Echos Bourse

Ce code fonctionne pour copier le Cours et le + HAUT :

Sub Lire_Cours_Potentiels()

    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur1 As String, Valeur2 As String
    Dim Cel As Range, I As Integer

    Sheets("Cours et Potentiels").Select
        ActiveSheet.Unprotect

    For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        IE.Navigate Cel
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document

        Set HtmlTag = IEDoc.getElementsByTagName("td")

        Valeur1 = "N/A": Valeur2 = "N/A"
        For I = 0 To HtmlTag.Length + 1
           
            If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur1 = HtmlTag.Item(I + 1).innerText

              If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur2 = HtmlTag.Item(I + 7).innerText       'Valeur2 = HtmlTag.Item(I - 1).innerText '
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 3) = Valeur1
        Cel.Offset(, 2) = Valeur2
    Next Cel

        IE.Visible = False

    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing


        IE.Visible = False
        
        Range("B1").Select
            ActiveSheet.Protect
        
                ActiveWorkbook.Save

End Sub

Modifié comme ci-dessous pour lire le Cours et l'Objectif de Cours à 3 mois,

            If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur1 = HtmlTag.Item(I + 1).innerText

              If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur2 = HtmlTag.Item(I + 22).innerText       'Valeur2 = HtmlTag.Item(I - 1).innerText '
              End If
                Exit For
            End If

Il copie bien le Cours mais pas l'Objectif dont il ne copie que le Nom (Objectif de Cours à 3 mois) et pas la Valeur !!

J'avoue ne pas comprendre la raison de ce "caprice" et vous demande donc de m'aider à résoudre ce problème.
Est-il par ailleurs possible de copier en même temps dans cette page le Cours, l'Objectif de Cours à 3 mois et le Potentiel ?


En vous remerciant pour votre aide et en vous souhaitant une bonne journée.

Cordialement.
Nonno 94.

 

[Pierrot93]

Re : Copie de données Internet (Problème de code)

Bonjour,

essaye peut être une requête sur le web, barre de menu Excel => données => données externes => nouvelle requête sur le web.

bonne journée
@+

 

[Nonno 94]

Re : Copie de données Internet (Problème de code)

Bonjour Pierrot et merci pour la réponse.

Votre proposition ne me convient malheureusement pas car il me faut utiliser une macro pour sélectionner ces mêmes données dans plus de 200 pages Internet pour les copier dans un fichier.
Pour quelle raison ce code fonctionne-t-il dans le 1 er cas et pas dans le 2 ème ?

Nonno 94.