1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
| Type AuthFormDef
' Adresse à atteindre
URL As String
' Action du formulaire d'identification
FormAction As String
' Nom du champ qui demande le nom d'utilisateur
UserField As String
' Nom du champ qui demande le mot de passe
PasswordField As String
' Valeur du champ Utilisateur
UserValue As String
' Valeur du champ Mot de passe
PasswordValue As String
End Type
' ---
' CONNEXION A INTERNET EXPLORER AVEC IDENTIFIANT / MOT DE PASSE
' ---
Function ConnexionIE(afd As AuthFormDef) As Boolean
Dim ie As Object
'Dim doc As MSHTML.HTMLDocument
' Dim frm As MSHTML.HTMLFormElement
Dim blnFormOK As Boolean
' Démarrer et afficher Internet Explorer
On Error GoTo ConnexionIEErr
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
' Naviguer vers la page et attendre qu'elle soit chargée
ie.navigate afd.URL
While ie.Busy
DoEvents
Wend
' Récupérer l'objet Document affiché
Set doc = ie.Document
' Identifier le formulaire demandé
blnFormOK = False
For Each frm In doc.Forms
If frm.Action = afd.FormAction Then
blnFormOK = True
' Trouver et renseigner les champs Identifiant/Mot de passe
' du formulaire
Dim obj As Object
For Each obj In frm.elements
If obj.Name = afd.UserField Then obj.Value = afd.UserValue
If obj.Name = afd.PasswordField Then obj.Value = afd.PasswordValue
Next
' Forcer l'envoi du formulaire
frm.submit
ConnexionIE = True
End If
Next
' Valeur de retour
ConnexionIE = blnFormOK
Exit Function
ConnexionIEErr:
MsgBox "Erreur : " & Err.Number & vbCrLf _
& Err.Description, vbExclamation
ConnexionIE = False
Exit Function
End Function
' ---
' TEST DU FORMULAIRE D'IDENTIFICATION
' ---
Sub TestConnexionIE()
Dim afd As AuthFormDef
' Paramètres de la connexion
With afd
.URL = "http://xxxxxxxxxxxx/adv"
.FormAction = "verif.php"
.UserField = "user"
.PasswordField = "passe"
.UserValue = "Utilisateur"
.PasswordValue = "xxxxxx"
End With
' Lancer la connexion
If ConnexionIE(afd) Then
MsgBox "Connexion établie !", vbInformation
Else
MsgBox "Echec de la connexion", vbExclamation
End If
End Sub |
Partager