Controle de internet explorer via vb

Télécharger le projet
Commenter

Description

ne pas oublier de declarer les references:
"MICROSOFT HTML OBJECT LIBRAIRY
"MICROSOFT MICROSOFT INTERNET CONTROL

Source / Exemple : 


>>>>>>>>>>>>>>Form1
Private Sub Form_Load()
Dim ie As New ie

With ie
    .Visible = True
    .IENavigate "www.google.fr"
    .Visible = False
    MsgBox .GetText
    .Visible = True
    .FormFillField "q", "vbfrance"
    .FormClickButton "btnG"
End With

End Sub

>>>>>>>>>>>>>>Créer un module de classe

'INSTALLER IE 5.5 Minimun
Option Explicit
'Ref "MICROSOFT HTML OBJECT LIBRAIRY
Dim WithEvents ie As InternetExplorer  'pour gérer les événement IE
'Ref "MICROSOFT MICROSOFT INTERNET CONTROL
Dim WithEvents WebDoc As HTMLDocument  'pour gérer les événement IE.Document
Dim ieHTML As String, ieTxt As String, ProgressBarre As Long

' pour gérer la synchro entre les procedures VBA et les événements IE
Dim IeStatus As Integer
Const Ready = -1
Const Busy = 0

Public Enum Pos
    pTop = 1
    pWidth = 2
    pHeight = 3
    pLeft = 4
End Enum

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'------------------- 3 FXs pour gérer synchro entre IE et ACCESS----------------
Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    On Error Resume Next
    IeStatus = Busy
End Sub

Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
    If pDisp <> "Microsoft Internet Explorer" Then Exit Sub
    If ie.readyState <> READYSTATE_COMPLETE Then Exit Sub
    IeStatus = Ready
    Set WebDoc = ie.document
    ieHTML = WebDoc.documentElement.innerHTML
    ieTxt = WebDoc.documentElement.innerText
End Sub

Private Sub IsReady()
On Error Resume Next
    While Not IeStatus = Ready
        DoEvents
    Wend
End Sub

Private Function IEStart() As Boolean

    On Error GoTo errs
    
    Set ie = New InternetExplorer
    IeStatus = Ready
    ie.Visible = False
    IEStart = True
    Exit Function
        
errs:

    IEStart = False

End Function

Public Sub FormClickButton(ButtonName As String)
    On Error Resume Next
    WebDoc.All(ButtonName).Click
End Sub

Public Sub FormFillField(FieldName As String, Value As String)
    On Error Resume Next
    WebDoc.All(FieldName).Value = Value
End Sub

Sub IEEnd()

    On Error Resume Next
    
    Set WebDoc = Nothing
    ie.Quit
    Set ie = Nothing
    IeStatus = Ready ' pour arreter la boucle isready

End Sub

Public Sub IENavigate(Addresse As String)
    On Error Resume Next
    IsReady
    ie.Navigate2 Addresse
    IsReady
End Sub

Private Sub IE_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
    ProgressBarre = Progress / (ProgressMax + 0.0001) * 100
    If ProgressBarre <= 0 Then ProgressBarre = 0.0001
    If ProgressBarre > 100.0001 Then ProgressBarre = 100.0001
End Sub

Public Property Get Position(WhichOne As Pos) As Variant
    On Error Resume Next
    Select Case WhichOne
        Case pTop
            Position = ie.Top
        Case pWidth
            Position = ie.Width
        Case pLeft
            Position = ie.Left
        Case pHeight
            Position = ie.Height
    End Select

End Property

Public Property Let Position(WhichOne As Pos, ByVal vNewValue As Variant)
    On Error Resume Next
    Select Case WhichOne
        Case pTop
            ie.Top = vNewValue
        Case pWidth
            ie.Width = vNewValue
        Case pLeft
            ie.Left = vNewValue
        Case pHeight
            ie.Height = vNewValue
    End Select
End Property

Public Property Get Visible() As Boolean
On Error Resume Next
Visible = ie.Visible
End Property

Public Property Let Visible(vNewValue As Boolean)
On Error Resume Next
ie.Visible = vNewValue
End Property

Public Property Get GetProgressBarre() As Long
On Error Resume Next
GetProgressBarre = ProgressBarre
End Property

Public Property Get GetStatusText() As String
    GetStatusText = ie.StatusText
End Property

Public Property Get GetHTML() As String
    On Error Resume Next
    GetHTML = ieHTML
End Property

Public Property Get GetText() As String
    On Error Resume Next
    GetText = ieTxt
End Property

Private Sub Class_Initialize()
    IEStart
End Sub
Télécharger le projet

Codes Sources

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.