Rechercher informations dans une page web

Bonjour,

Je me suis trouvé confronté à un dilemme: obtenir une info stockée sur un site web.

J'ai commencé à chercher sur le web et j'ai trouvé un tuto super intéressant sur la façon d'y arriver

J'ai appris à me servir des espions du VBA,

Je me suis entrainé à récupérer des infos de ma boite mail de free (zimbra.free.fr) : l'identifiant du message, l'expéditeur et l'entete du message

en gros j'ai fait d'excel, un genre d'outlook vraiment très très simpliste pour voir combien de mail j'ai dans ma boite.

ça n'a pas d'interet en lui meme si ce n'est d'apprendre à aller chercher des infos sur une page web, et apprendre à utiliser les espions.

pour que le fichier fonctionne pensez à vérifier que les références suivantes soient installés:

Microsoft HTML Object Librairy

Microsoft internet controls

& Windows script host object model

Voici le code

Dans le module 1 il y a :

Public Sub RecupInfoWebSite()
    Dim IE As InternetExplorer 'Déclaration de l'objet IExplorer
    Dim IEDoc As HTMLDocument 'Déclaration de la page web
    Dim InfoARecuperer As HTMLGenericElement, LigneTableau As HTMLGenericElement 'Déclaration des variables pour  récupérer nos infos
    Dim C As Range 'Déclaration du range qui nous servira plus tard
    Dim IdElement$ 'Chaine pour les identifiants des éléments de la page web
    Dim i%, j% 'Déclaration du entier

    'Instanciation d'IExplorer
    Set IE = CreateObject("InternetExplorer.application")

    'On indique l'adresse web souhaitée
    IE.Navigate2 "http://zimbra.free.fr"

    'On attend que la page se charge
    WaitIE IE

    'Instanciation de la page web
    Set IEDoc = IE.document

    'Affichage du formulaire pour sasir Login et password
    IdForm.Show

    'Après validation on rempli les champs de la page web
    IEDoc.all("login").Value = IdForm.Id.Value
    IEDoc.all("password").Value = IdForm.MdP.Value

    'en cas de problême d'identification on gère l'erreur
    On Error GoTo message

    'On simule le click pour valider nos identifiants
    IEDoc.all("Envoyer").Click

    'on met un petit message pour faire patienter l'utilisateur afin d'attendre que la page web finisse de se charger
    'Nécessite Windows script host object model
    appelMessTim

    ThisWorkbook.Activate
    'Instanciation de l'élément voulu via son id
    Set InfoARecuperer = IEDoc.getElementById("zl__CLV__rows")

    i = 2 'i=la ligne à partir de laquelle on écrit

    'Pour chaque ligne contenu dans le tableau sélectionné
    For Each LigneTableau In InfoARecuperer.Children

        'on vérifie quel'index est non ""
        If LigneTableau.Id <> "" Then

            'on renseigne l'id
            Range("a" & i) = LigneTableau.Id
            i = i + 1
        End If
    Next

    j = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'j est là pour compter le nb d'enregistrement

    'Pour chaque cellule du range
    For Each C In ActiveSheet.Range("A2:A" & j)

        'On modifie la chaine id stockée dans les cellules pour aller chercher l'expediteur du message
        IdElement = VBA.Mid(Range("A" & C.Row).Text, 1, 3) & "f" & _
              VBA.Mid(Range("A" & C.Row).Text, 4) & "__pa__0"

        'On instancie avec le nouvel id
        Set InfoARecuperer = IEDoc.getElementById(IdElement)

        'on copie la valeur dans la cellule à droite de l'id
        C.Offset(0, 1) = InfoARecuperer.innerText

        'on répète en modifiant l'id pour avoir l'entete du message
        IdElement = VBA.Mid(Range("A" & C.Row).Text, 1, 3) & _
               "f" & VBA.Mid(Range("A" & C.Row).Text, 4) & "__su"
        Set InfoARecuperer = IEDoc.getElementById(IdElement)

        'entete que l'on stocke 2 cellule à droite de l'id
        C.Offset(0, 2) = InfoARecuperer.innerText
    Next

    'on ferme Iexplorer
    IE.Quit

    'on Vide les variables
    Set InfoARecuperer = Nothing
    Set LigneTableau = Nothing
    Set IE = Nothing
    Exit Sub

    'gestion de l'erreur
message:         MsgBox "Erreur d'indentification, arrêt de la procédure"
End Sub

dans le module 2 :2 sub pour afficher une popup et temporiser la macro du module 1

Sub TimedMess(message As String, Duree As Integer, Optional Titre As String)

Dim SH As IWshRuntimeLibrary.WshShell
Set SH = New IWshRuntimeLibrary.WshShell
SH.Popup message, Duree, Titre, vbOKOnly 'Ici la durée c'est x secondes, tu peux la passer en argument de la fonction!

End Sub

Sub appelMessTim()

TimedMess "Patienter quelques instants que les infos soit stockés", 10, "Working"

End Sub

et enfin dans un autre module

' Attend que la page internet soit chargée
' pTimeOut est un time out en secondes (WaitIE vaut True si Timeout)
Public Function WaitIE(oIE As InternetExplorer, Optional pTimeOut As Long = 0) As Boolean
Dim lTimer As Double
lTimer = Timer
Do
    DoEvents
   If oIE.readyState = READYSTATE_COMPLETE And Not oIE.Busy Then Exit Do
   If pTimeOut > 0 And Timer - lTimer > pTimeOut Then
       WaitIE = True
       Exit Do
   End If
Loop
End Function

Je n'ai pas détaillé comment j'ai récupéré le Id des élément de la page web, c'est plutot bien expliqué dans le tuto dont le lien cesitue plus haut,

Si besoin posé vos questions j'essaierais d'apporter une réponses dans la mesure de mes compétences

321essaiie.zip (19.46 Ko)
Rechercher des sujets similaires à "rechercher informations page web"