Importer 2 données d'une page Internet

Nonno 94 · 2 Septembre 2012

Bonjour le Forum,

je viens solliciter votre aide pour modifier un Code qui me permettra d'importer en même temps d'une page Internet 2 données dont les adresses sont proches mais disjointes.

Pour importer ces données, j'utilise actuellement 2 codes différents et souhaiterais n'en utiliser qu'un seul ce qui, je pense, permettrait un gain de temps important (je dois lire plus de 200 pages et en importer 2 données par page).

Les codes utilisés sont les suivants :

Code:

Sub Lire_Objectifs()

    Sheets("Essai").Select                         'Lire Objectifs
    
    
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur As String, Cel As Range, I As Integer

                
        ActiveSheet.Unprotect
        
    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
                
    Range("B1").Select

        ActiveSheet.Protect
        
            ActiveWorkbook.Save
   
End Sub

Code:

Sub Lire_Potentiels()

    Sheets("Essai").Select                         'Lire Potentiels
    
    
    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur As String, Cel As Range, I As Integer

        ActiveSheet.Unprotect
        
    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 + 3).innerText
                Exit For
            End If
        Next I
        Cel.Offset(, 2) = Valeur

    Next Cel
   
    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing

    Range("C1").Select

        ActiveSheet.Protect
        
            ActiveWorkbook.Save

End Sub

Afin de vous permettre de mieux comprendre ma demande, je vous joins mon fichier "Essai 2".

Le Code à modifier est celui de la Macro "Lire_Objectifs_et_Potentiels" qui tel que je l'ai "bricolé", ne me permet d'importer que les Objectifs et pas les Potentiels.
Question supplémentaire : quel serait le Code si les 2 données se trouvaient à des adresses voisines (jointes) ?

Avec mes remerciements pour vos réponses et en vous souhaitant une bonne journée.

Cordialement.
Nonno 94.

JCGL · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Bonjour à tous,

Pourquoi passes-tu par une feuille intermédiaire ?
Mytå t'a apporté une solution sans ICI.

A + à tous

Edition : Oups, j'ai regardé la mauvaise macro. Désolé.

JCGL · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Bonjour à tous,

Peux-tu essayer ceci :

VB:

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


    Sheets("Essai").Select
    ActiveSheet.Unprotect


    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, I + 3).innerText
                Exit For
            End If
        Next I
        Cel.Offset(, 1) = Valeur


    For I = 0 To HtmlTag.Length - 1
        If HtmlTag.Item(I).innerText = "Potentiel" Then
            Valeur = HtmlTag.Item(I + 1, I + 3).innerText
            'Valeur = HtmlTag.Item(I + 5).innerText
            Exit For
        End If
    Next I
    Cel.Offset(, 2) = Valeur
Next Cel


Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("B1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub

A + à tous

Nonno 94 · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Bonjour JCGL,

je vous remercie chaleureusement pour votre réponse qui prouve que les "montagnards" n'excellent pas seulement sur les skis et autres engins "glissants" !
Votre code fonctionne parfaitement.

Une question subsidiaire pour un Chamois de "diamant" (mieux que l'or !) :
Quel code pour :
- Une plage et une cellule disjointe ?

Encore bravo et merci.

Cordialement;
Nonno 94.

Mytå · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Salut le forum

Comme ceci, afin d'éviter les deux boucles.

Code:

Sub Lire_Objectifs()
    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

    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 = "Objectif de cours à 3 mois" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText
              If HtmlTag.Item(I + 2).innerText = "Potentiel" Then
                Valeur2 = HtmlTag.Item(I + 3).innerText
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 1) = Valeur1
        Cel.Offset(, 2) = Valeur2
    Next Cel

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

    Range("B1").Select

End Sub

Mytå

JCGL · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Bonjour à tous,

- Une plage et une cellule disjointe ?

Je ne comprends pas la demande ?

Tu souhaites mettre les valeurs Potentiel dans une autre colonne que la C ?

A + à tous

Nonno 94 · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Re,

Non. Votre code me convient parfaitement pour ce fichier.
Je souhaite simplement savoir, pour éviter de vous déranger une nouvelle fois, comment modifier ce code si, dans un autre fichier je voulais importer des données de pages Internet qui se présenteraient sous différentes formes; à savoir:
- une plage de cellules
- une plage et une cellule disjointe
- un tableau
- une colonne
- une ligne

J'espère avoir été plus explicite !

Merci encore pour votre patience.
Nonno 94.

Nonno 94 · 2 Septembre 2012

Re : Importer 2 données d'une page Internet

Bonjour Myta,

Remerciements pour ce code modifié qui complète celui que vous m'aviez transmis précédemment et qui fonctionne parfaitement.

Cordialement.
Nonno 94

Importer 2 données d'une page Internet

Nonno 94

XLDnaute Occasionnel

JCGL

XLDnaute Barbatruc

JCGL

XLDnaute Barbatruc

Nonno 94

XLDnaute Occasionnel

Mytå

XLDnaute Occasionnel

JCGL

XLDnaute Barbatruc

Nonno 94

XLDnaute Occasionnel

Nonno 94

XLDnaute Occasionnel

Discussions similaires