Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

[Nonno 94]

Bonjour le Forum,

je suis confronté à un problème pour lequel je viens solliciter votre aide; à savoir: copier par macro dans une feuille Excel quelques 200 données (valeurs) se trouvant dans 200 pages Web semblables à celles dont les liens sont ci-dessous.

Cours ACCOR, action ACCOR - Cotation en temps réel - AC, Cotation Paris en direct - investir.fr

Cours AIR LIQUIDE, action AIR LIQUIDE - Cotation en temps réel - AI, Cotation Paris en direct - investir.fr

La méthode qui consiste à ouvrir ces pages puis les copier étant trop longue (2 minutes par page); soit 400 minutes (près de 7 heures !) pour copier ces 200 valeurs, je voudrais savoir s'il est possible avec une macro d'ouvrir ces pages avec un lien hyper-texte puis de sélectionner la valeur à copier et de la copier dans une feuille Excel SANS copier la page entière.
La valeur à copier est l'Objectif de cours à 3 mois et se trouve toujours sous le texte "Objectif de cours à 3 mois".
Pour cela, je suppose qu'il faut saisir dans la macro dont le code commencerait ainsi:

Sub Objectifs_Liens_hyper()
'
' Objectifs_Liens_hyper Macro
' Macro enregistrée le 23/08/2012 par Edmond
'

'
    Sheets("Objectifs").Select      'cette feuille contient les liens hyper dans la colonne A

    Range("A2").Select          'pour la 1 ère valeur
        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        'puis Code pour : Rechercher par la méthode 'Find' le texte 'Objectif de cours à 3 mois',
                               'sélectionner la cellule située en dessous et copier sa valeur dans la cellule B 2
                               'de la feuille Objectif
        
    Range("A3").Select          'pour la 2 ème valeur
        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        'puis Code pour : Rechercher par la méthode 'Find' le texte 'Objectif de cours à 3 mois',
                               'sélectionner la cellule située en dessous et copier sa valeur dans la cellule B 3
                               'de la feuille Objectif
                    
    Sheets("Objectifs").Select
        Range("A1").Select
End Sub

"l'adresse" de cette valeur dans la page Web, ce que je ne sais pas faire.
Mais peut-être est-ce impossible ?

Je vous remercie pour vos réponses et vous souhaite une bonne journée.
Cordialement.

Nonno 94.

 

[pijaku]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Bonjour,

A partir de cette discussion, je t'ai bidouillé ce code qui :
- a partir d'une liste d'adresse Internet situées en feuille "ACCUEIL" colonne A, à partir de A2,
- page Internet une par une,
- importe toute ta page Internet en feuille "IMPORT",
- cherche et trouve le texte "Objectifs à 3 mois",
- copie-colle la valeur contenue dans la cellule voisine en feuille "ACCUEIL" colonne B,
- Efface la feuille "IMPORT"
- passe à la page suivante.

Le code :

Sub importer()
Dim Lig As Long, DernLig As Long, Hyperlien, trouve As Range

With Sheets("ACCUEIL")
    DernLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To DernLig
        Hyperlien = .Range("A" & Lig).Value
        With Sheets("IMPORT")
            .Cells.Clear
            Import (Hyperlien)
            Set trouve = .Cells.Find("Objectif de cours à 3 mois", lookat:=xlWhole)
        End With
        If Not trouve Is Nothing Then .Range("B" & Lig).Value = trouve.Offset(0, 1).Value
    Next Lig
End With
With Sheets("IMPORT")
    .Cells.Clear
    .Cells.QueryTable.Delete
End With
End Sub

Sub Import(Lien)
Application.ScreenUpdating = False
    With Sheets("IMPORT").QueryTables.Add(Connection:="URL;" & Lien & "" _
    , Destination:=Sheets("IMPORT").Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
        .Name = ""
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Application.ScreenUpdating = True
End Sub

Le fichier exemple :
Classeur "Importation web.xls"

 

[Nonno 94]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Bonjour Frank,

mes sincères remerciements pour ce code fort bien "bricolé".
Seul petit problème, il faut plus d'une minute pour trouver une valeur soit plus de 3 heures pour trouver les 200 dont j'ai besoin !
Ceci parce que les pages Web sont copiées en totalité.
N'est-il pas possible de ne récupérer et copier dans chaque page que la valeur à trouver ?

Merci encore pour ce "bricolage".
Cordialement.

Nonno 94.

 

[pijaku]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

N'est-il pas possible de ne récupérer et copier dans chaque page que la valeur à trouver ?

Tout (ou presque) est possible.

Pour te le garantir, il faut que je testes pas mal de choses..... Par conséquent, peux tu me filer les 200 liens ou une grande partie d'entre eux?

 

[Nonno 94]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

J'admire ton .....courage !

Je te ferai parvenir les liens dès que possible.

Nouveaux remerciements.
A +

Monsieur Le Nordiste,

Ainsi que "promis" ci-dessus, vous voudrez bien trouver en pièce jointe votre fichier "enrichi" de quelques liens hyper-texte.

Cordialement.
Nonno 94.

 

[pijaku]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Après moultes essais, moultes recherches, je reviens avec un code un tantinet plus rapide.
Il nécessite :
- d'avoir Internet Explorer installé sur la machine
- d'activer les deux références : « Microsoft Internet Controls » et « Microsoft HTML Object Library ».

Le temps d'exécution du code que je t'ai donné ce matin, sur ma machine, pour les 29 adresses données :
228,5117 secondes. Soit 8 secondes par page Internet.
Le temps d'exécution, mêmes conditions pour ce code est de : 202,6523 secondes. Soit 7 secondes par page...

Si tu me dis que le temps passé est plus long sur ta machine, tu as peut être :
- une lenteur de connexion Internet,
- un manque de mémoire vive sur ta machine,
- une vieille machine.

Mais pour ça je ne peux rien.
Voici le code :

Sub ImportAvec_IE()
'activer deux références : « Microsoft Internet Controls »
                        'et « Microsoft HTML Object Library ».
'Pour accéder aux références dans VBA, menu Outils -> Références.
Dim Lig As Long, DernLig As Long, Hyperlien, trouve As Range

Dim s2 As String
Dim i1 As Long, l As Long
Dim IE As New InternetExplorer

Application.ScreenUpdating = False
IE.Visible = True
With Sheets("ACCUEIL")
    DernLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To DernLig
        With Sheets("IMPORT")
            .Cells.Clear
        End With
        Hyperlien = .Range("A" & Lig).Value
        IE.Navigate Hyperlien
        Do Until IE.ReadyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        For i1 = 0 To IE.Document.all.tags("TD").Length - 1
            s2 = IE.Document.all.tags("TD").Item(i1).innerText
            l = l + 1
            Sheets("IMPORT").Range("A" & l) = s2
        Next i1
        On Error Resume Next
        With Sheets("IMPORT")
            Set trouve = Sheets("IMPORT").Columns(1).Cells.Find("Objectif de cours à 3 mois")
        End With
        If Not trouve Is Nothing Then .Range("B" & Lig) = trouve.Offset(1, 0).Value
    Next
End With
Application.ScreenUpdating = True
trouve = Nothing
IE.Quit
End Sub

 

[Nonno 94]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Merci une nouvelle fois.

Ai décollé à Orly et la macro s'est exécutée si rapidement que j'ai "raté" la piste en herbe de Lesquin pour me retrouver à Amsterdam-Schipol. Le vol a duré environ 4 minutes 30 soit moins de 10 secondes par valeur. Sur mon vieux "coucou", c'est honorable.

Vous êtes "trop fort" Monsieur Le Nordiste !!!!

Bravo

 

[Mytå]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Salut le forum

Alt+F11(Accès au VBA) ensuite dans Outils » Références

Mytå

 

[Compte Supprimé 979]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Bonjour le fil,

Juste pour dire à Mytå que je suis content de te revoir un peu sur le forum

A+

 

[Nonno 94]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Comment marquer que le sujet est résolu et accorder 6 étoiles à cette discussion ?

Je renouvelle mes remerciements. EXCEllente fin de semaine.

Cordialement.
Nonno 94. (qui habite près d'Orly et se rend régulièrement dans la région chère à Franck en passant donc près de Lesquin!!)

 

[Mytå]

Re : Copier dans une feuille Excel 2OO données de 200 pages Web (1 donnée par page)

Re Nonno94, pijaku, BrunoM45 et le forum

Juste pour éviter une feuille intermédiaire. (Temps traitement 120 sec.)

Option Explicit

Sub Lire_Cotes()
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur As String, Cel As Range, I As Integer

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

        Set HtmlTag = IEDoc.getElementsByTagName("td")

        Valeur = "N/A"
        For I = 0 To HtmlTag.Length - 1
            If HtmlTag.Item(I).innerText = "Objectif de cours à 3 mois" Then
                Valeur = HtmlTag.Item(I + 1).innerText
                Exit For
            End If
        Next I
        Cel.Offset(, 1) = Valeur
    Next Cel
    
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing
    
End Sub

Pour récupérer le titre de la page WEB

Cel.Offset(, 2) = Split(IEDoc.Title, ",")(0)

Mytå

P.S. Salut BrunoM45, c'est vrai que je suis moins présent sur le forum comme répondant.