CONNECTION INTERNET VIA VBA

'Il est nécessaire de référencer IE dans votre programme dans le VBA
'outils - références - référencer les outils ... sinon ca marche pas ....


'Code à insérer dans un module

Public Etat As String
Public IE As New InternetExplorer                  '****** Internet Explorer
Public LibelleLien As String                        '****** Libelle du lien IE



Sub ConnectionIE()

'définition de IE en tant que nouvel Objet
'rend IE visible
IE.Visible = True
'IE navique vers le site demandé
IE.Navigate2 "http://www.VotreSite.fr/"

'Fonction Timer ... regardé plus bas ... la fonction est décrite
If Timer = False Then GoTo Error_Timer

'défini la variable de la page web.
Dim htmlDoc As HTMLDocument
Set htmlDoc = IE.document
While htmlDoc.Title <> "Nom de la page Web"
Wend

'la variable htmlDoc peut prendre les attributs suivants :
IETxt = htmlDoc.documentElement.innerText         'récupère le texte de la page HTML
IESource = htmlDoc.documentElement.innerHTML      'récupère le code source de la page HTML
IETitre = htmlDoc.Title                           'récupère le Titre du document HTML
IENom = htmlDoc.Name                              'récupère le Nom "Microsoft Internet Explorer"


'**************** Défini le un controle de la page **************************
Dim IECtrl As HTMLFormElement
Set IECtrl = htmlDoc.forms(0).'Nom du controle
'Insert une valeur dans un controle dans la page en cours
IECtrl.Value = "La Valeur Que je veux y mettre"

'récupère une valeur d'un controle de la page en cours et le met dans une cellule
Selection = IECtrl.Value 

'**************** Défini l'envoi de la page ne cours (simulation de la touche entrer *************************
Dim IESubmit As HTMLFormElement
Set IESubmit = htmlDoc.forms(0)
IESubmit.submit
If Timer = False Then GoTo Error_Timer

'**************** Ckiquer sur un lien IE************************
If CliquerLien("libellé du lien sur IE", "Nom de la page suivante") = False Then Exit Sub


'**************** Arret Programme correctement ************************
IE_Fin:
Application.Visible = True
MsgBox "Arrêt du programme", vbInformation, "Fin"

'**************** Arret Programme Error Timer ************************
Error_Timer:
IE.Quit
Set IE = Nothing
End Sub


'**********************************************************************************
'****************************      FONCTION TIMER DE IE    ************************
'**********************************************************************************
Function Timer() As Boolean
On Error GoTo Error_IE_Timer
While IE.readyState <> READYSTATE_COMPLETE
Wend
While IE.Busy
Wend
Timer = True
Exit Function
Error_IE_Timer:
Timer = False
MsgBox "Arrêt de Internet Explorer dû à une erreur interne de l'application", vbInformation, "Erreur Application Internet Explorer"
End Function

'**********************************************************************************
'**************************** FONCTION Cliquer sur lien IE ************************
'**********************************************************************************
Public Function CliquerLien(LibelleLien As String, Optional NomPageSuivante As String) As Boolean
On Error GoTo ErrLien 'si erreur av ç la gestion de l'erreur
Dim ObjLien As HTMLLinkElement (défini les liens de la page en Objet
For Each ObjLien In IE.document.Links 'pour chaque lien de la page active
    If ObjLien.innerText = LibelleLien Then 'si le text du lien = au Libellé visible sur la page alors
        TextePage = IE.document.documentElement.innerText 
        ObjLien.Click 'clique sur le lien
        If Timer = False Then GoTo ErrTimer 'gestion du time sur IE
        If NomPageSuivante <> "" Then 'si le nom de la page a été renseigné dnas la fonction alors
            While IE.document.Title <> NomPageSuivante 'attends jusqua ce que la page change (2e gestion du passage de la page qui peuit etre tres utile)
            Wend
        Else
            While IE.document.documentElement.innerText <> TextePage
            Wend
        End If
        CliquerLien = True: Exit Function 'tout c'est bien passer alors la fonction CliquerLien prend la TRUE
        Exit For
    End If
Next ObjLien


'Sinon prend la valur FALSE
CliquerLien = False
'Permet de demander à l'utilisateur s'il désire terminé l'action manuellement dans le cas ou cela n'a pas fonctionné
Message = "Une erreur est surevenue sur le lien : " & LibelleLien & "."
Message = Message & vbCrLf & "Oui : Je souhaite terminer l'action manuellement ?"
Message = Message & vbCrLf & "Non : Je souhaite terminer le programme ?"
If MsgBox(Message, vbQuestion + vbYesNo, "Erreur sur le lien : < " & LibelleLien & " >") = vbYes Then
    TextePage = IE.document.documentElement.innerText
    While TextePage = IE.document.documentElement.innerText
    Wend
    If Timer = False Then GoTo ErrTimer
    CliquerLien = True: Exit Function
End If

ErrLien:
CliquerLien = False: Exit Function

ErrTimer:

IE.Quit
Set IE = Nothing: Exit Function
    
End Function


'**********************************************************************************
'********************** Fonction RECUPERER TEXTE sur IE par Valeur Texte **********
'**********************************************************************************
Public Function RécupérerTexte(TexteARechercher As String, TexteARécupérer As String) As String
Dim MaPosition As Variant
Dim TextePage As String

On Error GoTo ErrRécupérerTexte

TextePage = IE.document.documentElement.innerText 'récuper le texte entier de la page IE (faite un test avec msgbox TextePage)
MaPosition = InStr(1, TextePage, TexteARechercher)
RécupérerTexte = Mid(TextePage, MaPosition + Len(TexteARechercher), Len(TexteARécupérer))
Exit Function



ErrRécupérerTexte:
    SearchTexte = False
End Function