QueryTable.Refresh : Excel ne répond pas

**Daniel.C** · 23/11/2018, 15h16

Bonjour,

Je récupère la liste des joueurs de tennis sur un site web. Ca représente un certains nombre de requêtes (78 pays et un nombre variable de pages par pays.
D'une façon presque systématique, Excel cesse de répondre. J'ai essayé de faire une boucle sur le "Refresh".. J'ai aussi affiché la page et le nombre d'essais dans la barre d'état. Ca fonctionne... tant que l'exécution est normale.
Est-il possible que l'erreur soit liée à Windows 10 ? Ca semble coïncider, mais on ne prête qu'aux riches... Je poste ci-dessous la partie litigieuse du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
        On Error Resume Next
        For Each Item In Array(Plage1, Plage2, Plage3)
          Set Plage = Item
          For Each C In Plage
'              Debug.Print C.Value
  '            If C.Row = 16 Then Stop
              For I = 1 To 150
 
                  .QueryTables(1).Delete
                  Ligne = .[A:D].Find("*", , , , xlByRows, xlPrevious).Offset(1).Row
                  If Ligne = 2 Then Ligne = 1
                  Set Desti = .Range("A" & Ligne + 1)
                  Txt = "URL;http://www.tennisexplorer.com/list-players/?page=" & I & "&country=" & _
                      LCase(Application.Trim(C.Value)) & "&order=name"
                  Set Qt = .QueryTables _
                   .Add(Connection:=Txt, _
                   Destination:=Desti)
                  With Qt
                   Rep = False
                   Ctr1 = 0
                   .Connection = Txt
                   .Destination = Desti
'                   .Name = "ListeJoueurs"
                   .WebFormatting = xlNone
                   .WebSelectionType = xlSpecifiedTables
                   .BackgroundQuery = False
                   .WebTables = "2"
                   Do Until Rep = True
                    Rep = .Refresh
                    DoEvents
                    Ctr1 = Ctr1 + 1
'                    If Ctr1 > 1 Then Application.Wait Now + TimeValue("0:0:1")
                      If Ctr1 > 1 Then
 
                        Start = Timer    ' Set start time.
                        Do While Timer < Start + pausetime
                            DoEvents    ' Yield to other processes.
                        Loop
                      End If
                    If Ctr1 > 1000 Then
                      Application.StatusBar = "Erreur : " & LCase(Application.Trim(C.Value)) & _
                        " page " & I & "essai " & Ctr1
                      Exit Sub
                    End If
                   Loop
                   Application.StatusBar = LCase(Application.Trim(C.Value)) & " page " & I & _
                     " essai " & Ctr1
                  End With
                  If Desti(1, 1) <> "ATP" Then GoTo Fin
              Next I
Fin:
            For Each cnx In ActiveWorkbook.Connections
                If cnx.Name <> "Connexion" Then cnx.Delete
            Next
          Next C
        Next Item
        On Error GoTo 0

Merci d'avance.