Copier une page HTML vers Excel

Bonjour à tous ,

J'ai besoin de votre aide :fou:

je n'arrive pas a coller la page web obtenu apres l'entrée du mdp et du login par la macro sur la feuil2 afin de vérifier si la connexion à fonctionner.

Je mets la macro que j'utilise ci-dessous.

Gmail etant un exemple

Sub connexion()
For Each X In Sheets("Feuil1").Range("b2:" & Sheets("Feuil1").Range("b65536").End(xlUp).Address)
    Sheets("Feuil2").Cells.Clear
    login = X.Value
    Password = X.Offset(0, 1).Value

    Dim IE As InternetExplorer
    Dim IEdoc As Object
    Dim DOCelement As Object

    Set IE = New InternetExplorer
    IE.Visible = True
    IE.navigate ("http://gmail.com/")

     ' attente de fin de chargement
    Do Until IE.readyState = 4
        DoEvents
    Loop

    Set IEdoc = IE.document
    Sheets("Feuil2").Cells.Clear

    'login
     Set DOCelement = IEdoc.getElementsByName("email").Item
     DOCelement.Value = login

    'password
     Set DOCelement = IEdoc.getElementsByName("PASSWD").Item
     DOCelement.Value = Password
     DOCelement.Select

    'connexion
     Set DOCelement = IEdoc.forms(0)
     DOCelement.submit

Next
End Sub

je connais ce code qui fonctionne mais que sur l'url indiquez

With Sheets("feuil2").QueryTables.Add(Connection:="URL;http://gmail.com", Destination:=Sheets("feuil2").Range("A1"))
      .BackgroundQuery = True
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .Refresh BackgroundQuery:=False
    End With

Merci d'avance pour votre aide.

Bonjour,

je ne suis pas trop sur de comprendre ce que tu veux copier, mais remplace la ligne suivante pour essayer

With Sheets("feuil2").QueryTables.Add(Connection:="URL;http://gmail.com", Destination:=Sheets("feuil2").Range("A1"))

par

With Sheets("feuil2").QueryTables.Add(Connection:="URL;" & IE.LocationURL, Destination:=Sheets("feuil2").Range("A1"))

ça va prendre l'url du navigateur une fois que tu es enregistré sur gmail. Je ne l'ai pas testé, peut-être qu'il y aura un problème avec la sécurité du site, mais avec une page standart ça fonctionne

donne moi des nouvelles

Merci pour ta réponse,

Tu as bien compris ce que je voulais faire. Cela fonctionne parfaitement.

Merci à toi pour ton aide.

Bonsoir Math,

j'ai répondu trop vite,

Petite précision : Je souhaite copier toute la page qui s'affiche après l'entrée du mdp et du login.

With Sheets("feuil2").QueryTables.Add(Connection:="URL;" & IE.LocationURL, Destination:=Sheets("feuil2").Range("A1"))

Cette macro (qui fonctionne sur un site avec cookie pour le mdp et le user), malheureusement, le site que j'utilise à l'ouverture d'une nouvelle fenêtre oblige de saisir de nouveau le login et mdp.

Y'aurait t'il une fonction qui se positionne sur la fenêtre IE deja ouverte et la copie colle dans la feuille Excel ?

Merci encore pout ton aide

bonsoir,

en cherchant un peu sur le net j'ai trouvé la procédure suivante qui pourrait t'intéressé

Sub Fenetres_IE()
    'Nécessite d'activer la référence
    '"Microsoft Internet Controls"
    'et
    '"Microsotf HTML Object Library"

    Dim IE As New InternetExplorer
    Dim winShell As New ShellWindows
    Dim maPageHtml As HTMLDocument

    On Error Resume Next

    For Each IE In winShell
        If IE.LocationURL <> "" Then
            Set maPageHtml = IE.document
            MsgBox maPageHtml.DocumentElement.innerText

            Set maPageHtml = Nothing
        End If
    Next IE
End Sub

autre ressource:

http://jacxl.free.fr/cours_xl/cours_xl_jac.html#ouvrir_web

bonne soirée

Merci énormément MATH pour l'ensemble des éléments que tu m'as fourni.

J'ai réussi en grande parti grâce à toi.

Je mets l'ensemble du code.

Sub connexion()
For Each X In Sheets("Feuil1").Range("b2:" & Sheets("feuil1").Range("b6").End(xlUp).Address)
    Sheets("Feuil2").Cells.Clear
    login = X.Value
    Pass = X.Offset(0, 1).Value

    Dim IE As InternetExplorer
    Dim IEdoc As Object
    Dim DOCelement As Object

    Set IE = New InternetExplorer
    IE.Visible = True
    IE.navigate ("http:url/")

     ' attente de fin de chargement
    Do Until IE.readyState = 4
        DoEvents
    Loop

    Set IEdoc = IE.document
    Sheets("Feuil2").Cells.Clear

    'login
     Set DOCelement = IEdoc.getElementsByName("usr").Item
     DOCelement.Value = login

    'password
     Set DOCelement = IEdoc.getElementsByName("passrd").Item
     DOCelement.Value = Pass
     DOCelement.Select

    'connexion
     Set DOCelement = IEdoc.forms(0)
     DOCelement.submit

Fenetres_IE

Set Result = Sheets("Feuil3").Range("c1")
    If Result <> Sheets("Feuil3").Range("a1") Then
        X.Offset(0, 2) = "LOGIN KO"
    Else
        X.Offset(0, 2) = "LOGIN OK"
    End If
IE.Quit 'option pour les fermer
Next
End Sub

Sub Fenetres_IE()
    'Nécessite d'activer la référence
    '"Microsoft Internet Controls"
    'et
    '"Microsotf HTML Object Library"

    Dim IE As New InternetExplorer
    Dim winShell As New ShellWindows
    Dim maPageHtml As HTMLDocument

    On Error Resume Next

    For Each IE In winShell
        If IE.LocationURL <> "" Then
            Set maPageHtml = IE.document
            Sheets("feuil2").Range("a1") = maPageHtml.DocumentElement.innerText

            Set maPageHtml = Nothing
        End If
    Next IE
End Sub

Dans le classeur 3 et la cellule C1 j'ai mis cette formule

=STXT(Feuil2!A1;1;7)

Dans le classeur 3 et la cellule A1 j'ai mis le mot qui doit apparaitre si la connexion est ok.

Voila merci encore Math pour ton aide