rapatrier le code source html en VBA

Anonyme
2015-10-22T03:25:26+00:00

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

Microsoft 365 et Office | Excel | Pour la maison | Windows

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 Aucun commentaire
Réponse acceptée par l’auteur de la question
Anonyme
2015-10-26T07:50:38+00:00

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.

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

0 commentaires Aucun commentaire

22 réponses supplémentaires

  1. 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
  2. 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
  3. 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
  4. 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