[VBA] Boucler sur la méthode Workbooks.Open plante Excel

Bonjour,
Je récupère en VBA via la méthode Workbooks.Open(monUrl) le contenu d'une page Html.
Pour en récupérer plusieurs, je fais une boucle pour récupérer itérativement l'ensemble des données dont j'ai besoin.
Mon problème est qu'à partir d'un certain point (j'ai l'impression aléatoirement) la méthode Open plante et j'ai :

* Soit Excel qui plante complètement (page blanche, puis Excel se ferme entièrement)

* Soit le message d'erreur "La méthode Workbooks.Open a echoué" ou Impossible d'ouvrir www.google.fr

J'ai trouvé un post expliquant qu'Excel posait problème à ce niveau là : http://support2.microsoft.com/kb/210684/fr#survey
Mais malgré le fait de fermer le classeur puis de le rouvrir, pas moyen de récupérer l'ensemble des informations des pages !

Vous avez une idée pour contourner ça ?

Ci-dessous le code VBA que j'utilise (fichier TestCopieIndex_Baremes_memeOnglet.xlsm) :

Code:

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
Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim oBookTemp As Workbook
    Dim iCounter As Integer
    Dim nbLinges As Long
    Dim ligne As Long
 
    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
 
    ' Save the workbook:
    oBook.SaveAs "C:\Users\MERTZJL\testRecup_memeOnglet2.xlsx"
 
    ' Copy the sheet in a loop. Eventually, you get error 1004: Copy Method of Worksheet class failed.
    For iCounter = 1 To 100
        Set oBookTemp = Application.Workbooks.Open("http://www.google.fr")
 
        'On supprime également la petite image et on met en forme
        For Each monImage In oBookTemp.Worksheets(1).Shapes
            monImage.Delete
        Next monImage
        For Each monLien In oBookTemp.Worksheets(1).Hyperlinks
            monLien.Delete
        Next monLien
 
 
        oBookTemp.Worksheets(1).Copy After:=oBook.Worksheets(1)
        oBookTemp.Close SaveChanges:=False
 
        'Copie de la zone délimitée par ce nombre de lignes
        nbLignes = oBook.Worksheets(2).Range("A100000").End(xlUp).Row
        oBook.Worksheets(2).Range("A1:A" & nbLignes).EntireRow.Copy
        'On le colle dans l'onglet correspondant dans le fichier principal
        ligne = oBook.Worksheets(1).Range("A1000000").End(xlUp).Row + 4
        oBook.Worksheets(1).Range("A" & ligne).PasteSpecial xlPasteAll
        oBook.Worksheets(1).Range("A" & ligne & ":A" & ligne + 1).EntireRow.Delete
 
        Application.DisplayAlerts = False
        oBook.Worksheets(2).Delete
        Application.DisplayAlerts = True
 
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 20 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("C:\Users\MERTZJL\testRecup_memeOnglet2.xlsx")
        End If
    Next
End Sub

J'ai essayé de faire la même chose sans concaténer mes informations dans le même onglet et étrangement ça passe (fichier TestCopieIndex_Baremes.xlsm) :

Code:

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
Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim oBookTemp As Workbook
    Dim iCounter As Integer
    Dim nbLinges As Long
    Dim ligne As Long
 
    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp
 
    ' Save the workbook:
    oBook.SaveAs "C:\Users\MERTZJL\testRecup_memeOnglet.xlsx"
 
    ' Copy the sheet in a loop. Eventually, you get error 1004: Copy Method of Worksheet class failed.
    For iCounter = 1 To 100
        Set oBookTemp = Application.Workbooks.Open("http://www.google.fr")
        'On supprime également la petite image et on met en forme
        For Each monImage In oBookTemp.Worksheets(1).Shapes
            monImage.Delete
        Next monImage
        For Each monLien In oBookTemp.Worksheets(1).Hyperlinks
            monLien.Delete
        Next monLien
 
        Application.SheetsInNewWorkbook = iTemp
 
        oBookTemp.Worksheets(1).Copy After:=oBook.Worksheets(1)
        oBookTemp.Close SaveChanges:=False
 
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 20 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("C:\Users\MERTZJL\testRecup_memeOnglet.xlsx")
        End If
    Next
End Sub

Merci.