Connection internet via vba

Commenter

Contenu du snippet

Ce code permettra de se connecter à Internet Explorer et d'y naviguer ... récupérer des données ou y envoyer des données.
Attention je n'ai pa insérer toutes les fonctions, et il est nécessaire de connaitre la stucture du HTML afin de pouvoir optimiser votre code.

Attention, ceci est ma première source, alors je vous demanderais d'être critique. Merci à tous ceux qui la lirons.

Source / Exemple : 


'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

Conclusion :


Vous pouvez définir toute vos fonctions sur IE, mais il n'y a pas de fonction natives.
Vous devrez surement modifier vos fonctions par rapport à la page HTML.

Les bugs ... il peut y en avoir ...
Le plus important est de connaitre le nom de chaque champs dans votre page.

En espérant que cela pourra vous aider ...

ChaPaTa

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_chapata)