rapatrier le code source html en VBA

Anonyme

Bonjour

Cette routine fonctionnait correctement sous XP et depuis que je suis sous W8.1 elle ne fonctionne plus. J'ai déjà posé cette question il y a quelque temps, si il y a du nouveau à ce propos; bien aimable de me tenir au courant. Merci

Sub CherchecodeSource()

Dim CodeSource As String, IE As Object

Dim TempFile As String

On Error Resume Next

Feuil10.[A:A].ClearContents

Set IE = CreateObject("InternetExplorer.application")

TempFile = "c:\Fred.txt"

IE.Visible = False ' Ou True

IE.navigate URL:="http://www.tierce-magazine.com/accueil/pid107-les-reunions-du-jour.html?day=tomorrow"

Do Until IE.ReadyState = 4

DoEvents ' soit la boucle ne sort pas, soit elle sort et "Laligne" est vide dans la boucle suivante

Loop

CodeSource = IE.document.body.innerHTML

Open TempFile For Output As #1

Print #1, CodeSource

Close #1

Open TempFile For Input As #1

Do While Not EOF(1)

Input #1, LaLigne

a = a + 1

Feuil10.Range("A" & a) = LaLigne

If a > 20 And Application.CountA([IDcours!A:A]) = 0 Then

Exit Do

End If

Loop

Close #1

Kill TempFile

IE.Quit

Set IE = Nothing

End Sub

Question verrouillée. Cette question a été migrée à partir de la Communauté Support Microsoft. Vous pouvez voter pour indiquer si elle est utile, mais vous ne pouvez pas ajouter de commentaires ou de réponses ni suivre la question.

0 commentaires

Réponse acceptée par l’auteur de la question

Anonyme

Bonjour

Comme je l'ai indiqué le code tourne avec Office 2010 et IE11/w7.

Par contre on récupère du texte html et non les valeurs qui vous intéressent.

Je ne peux pas aller plus loin n'ayant plus ni IE8, ni Excel 2007.

0 commentaires

22 réponses supplémentaires

Anonyme

2015-10-28T16:21:02+00:00

Bonjour,

J'ai essayé avec Excel 2007 et Excel 2013 sous Windows 7 et Windows 10. Je n'ai pas été capable d'obtenir le résultat voulu. Pour la part, j'arrête là, à moins que je ne trouve mention du problème. Dans ce cas, je rouvrirai le fil.

Daniel
Cette réponse a-t-elle été utile ?

0 commentaires Aucun commentaire
Anonyme

2015-10-29T08:34:28+00:00

Bonjour Daniel

Trouvé sur internet il y a quelques jours mais qui ne m'avait pas donné satisfaction vu que le résultat comportait qu'une ligne, en retombant dessus ce matin, code que j'avais déjà enregistré sur un module, ça m'a fait "Tilt" avec une partie de ta proposition.: le Lien:

http://excel-malin.com/codes-sources-vba/obtenir-code-source-html-page-web/

Sub ExempleExtractionHTML()

'par: Excel-Malin.com ( http://excel-malin.com )

EnaF

    On Error GoTo ExempleErreur

    Dim MonLienURL As String

    MonLienURL = "http://www.tierce-magazine.com/accueil/pid107-les-reunions-du-jour.html?day=tomorrow"    '<-- placez ici votre lien

    Codehtml = ExtraireSourceHTML(MonLienURL)

    [IDcours!A:A].ClearContents

    Tabl = Split(Codehtml, ",") ' ID Daniel

    For Each Item In Tabl    ' ID Daniel

        Ligne = Ligne + 1      ' ID Daniel

        Feuil10.Cells(Ligne, 1) = Item ' ID Daniel

    Next Item ' ID Daniel

    'votre code pour traiter les données obtenues

'    MsgBox "Apperçu du code HTML de " & MonLienURL & ":" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & _

           Left(Codehtml, 350)    '= exemple: affiche un message avec les premiers 350 caractères du code HTML

EnaT

    Exit Sub

ExempleErreur:

    MsgBox "Une erreur est survenue..."

    EnaT

End Sub

Public Function ExtraireSourceHTML(LienURL As String)

'par: Excel-Malin.com ( http://excel-malin.com )

    On Error GoTo ExtraireSourceHTMLErreur

    With CreateObject("MSXML2.XMLHTTP")

        .Open "GET", LienURL, False

        .send

        If .ReadyState = 4 Then

            If .Status <> 200 Then

                ExtraireSourceHTML = CVErr(xlErrNA)

            Else

                ExtraireSourceHTML = .responseText

            End If

        Else

            ExtraireSourceHTML = CVErr(xlErrNA)

        End If

    End With

    Exit Function

ExtraireSourceHTMLErreur:

    ExtraireSourceHTML = CVErr(xlErrNA)

End Function
Cette réponse a-t-elle été utile ?

0 commentaires Aucun commentaire
Anonyme

2015-10-29T10:15:15+00:00

Bonjour,

Est-ce ce que tu souhaites obtenir ?

Daniel
Cette réponse a-t-elle été utile ?

0 commentaires Aucun commentaire
Anonyme

2015-10-29T12:34:12+00:00

C'est seulement pour te fournir info.
Cette réponse a-t-elle été utile ?

0 commentaires Aucun commentaire