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. 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. |
Forums