Rapport de message :*
 

Re: Extraction de données sur pages web

Titre du sujet : Re: Extraction de données sur pages web
par Icedarts le 03/10/2016 18:23:24

Bonsoir le forum, MDF,

 

Après de nombreuses années sans m'occuper de ce fichier j'en ai à nouveau besoin aujourd'hui.

Et au lancement petit message d'erreur sur le composant webBrowser.

Image redimensionnée

Surement du au fait que je suis sous excel 2016 maintenant.

 

Mon fichier est trop volumineux et je ne sais pas pourquoi il n'y a rien dedans donc voici le code:

Option Explicit
'myDearFriend!  -  www.mdf-xlpages.com
Const UrlDepart As String = "http://joueurfd.com/TEST2/statistique ... AmV4VFlXelhYcE5aHgA"

Private Sub btnGo_Click()
    WebBrowser1.Navigate UrlDepart
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim debut As Integer
Dim TabTemp As Variant
Dim L2 As Long, Lign As Long
Dim Col As Byte
Static L As Long
    If URL = UrlDepart Then
        If Cells(1, 1).Interior.ColorIndex = xlNone Then L = 0
        L = L + 1
        With WebBrowser1.Document
            .all("[LICENCE]").Value = Cells(L, 1).Text
            .all("B3").Click
            Cells(L, 1).Interior.ColorIndex = 6
        End With
    ElseIf URL = "http://www.france-darts.com/gestion/htm/LICENCED.ASP" Then
        Application.ScreenUpdating = False
        TabTemp = Split(WebBrowser1.Document.Body.InnerText(), vbCrLf)
        With Sheets("données")
            Lign = .Cells(Application.Rows.Count, 1).End(xlUp).Row + 1
            debut = Lign
            For L2 = 0 To UBound(TabTemp) Step 4
                 If Application.CountIf(.Columns(1), TabTemp(L2)) = 0 Then
                       .Cells(Lign, 1).Value = TabTemp(L2)
                       Lign = Lign + 1
                 End If
            Next L2
        End With
      If Cells(L + 1, 1) <> "" Then btnGo_Click Else MsgBox ("Traitement terminé !")
    End If
End Sub

Au cas ou voici un lien pour récupérer le fichier excel.

 

Merci d'avance.