VBA Access Webbrowsers... SUPER DEFI!!!

Option Compare Database


Const tempsSeconde = 10

Dim postDataPage
Dim urlPage
Dim bStopBoucle

Private Sub btnAccueil_Click()
webBrowser.GoHome
End Sub

Private Sub btnGo_Click()
goBrowser txtURL.Value
End Sub

Public Sub goBrowser(url As String)
On Error Resume Next
bStopBoucle = False
urlPage = url
webBrowser.Navigate2 urlPage, 0, "_self"
Do Until bStopBoucle
    Dim dateDebut
    dateDebut = Now
    Do Until ((Abs(DateDiff("s", Now, dateDebut)) > tempsSeconde And webBrowser.ReadyState >= 2) Or bStopBoucle)
    DoEvents
    Loop
    txtPOST.Value = postDataPage
    webBrowser.Navigate2 urlPage, &H4 Or &H8, "_self", postDataPage
Loop
End Sub

Private Sub btnNext_Click()
On Error Resume Next
webBrowser.GoForward
End Sub

Private Sub btnRefresh_Click()
On Error Resume Next
webBrowser.Refresh2 3
End Sub

Private Sub btnPrecedent_Click()
On Error Resume Next
webBrowser.GoBack
End Sub

Private Sub btnStop_Click()
webBrowser.Stop
End Sub

Private Sub btnStopBoucle_Click()
bStopBoucle = True
End Sub

Private Sub webBrowser_DocumentComplete(ByVal pDisp As Object, url As Variant)
txtURL.Value = url
urlPage = url
'If (URL = urlPage) Then
'Dim dateDebut
'dateDebut = Now
'Do Until (DateDiff("s", Now, dateDebut) > tempsSeconde)
'DoEvents
'Loop
'webBrowser.Navigate2 urlPage, 0, "_self", postDataPage
'End If
End Sub

Private Sub webBrowser_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
Dim strResult
strResult = ""
Dim bytes As Variant
bytes = CVar(PostData)
For I = 0 To UBound(bytes)
strResult = strResult & Chr(bytes(I))
Next
'If (url = urlPage) Then
If (txtPOST.Value = Null) Then
txtPOST.Value = vbNullString
End If
If (strResult <> vbNullString) Then
txtPOST.Value = Now & ": " & vbCrLf & strResult & vbCrLf & "-----------------" & txtPOST.Value
End If
postDataPage = PostData
'End If
End Sub

dim postDataPage
dim urlPage

sub initialization()
url = "https://www.lesite.com/"
demarrerBoucle...
end sub

sub aChaqueXMin()
controleWeb.navigate2 url, 0, "_self", postData
end sub

Private Sub object_BeforeNavigate2( ByVal pDisp As Object, ByRef Url As Variant, ByRef Flags As Variant, ByRef TargetFrameName As Variant, ByRef PostData As Variant, ByRef Headers As Variant, ByRef Cancel As Boolean)
if(urlPage = Url and PostData <> Nothing) then
postDataPage= postData
end if 
end sub