Bonjour,
Voici mon 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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
 
Option Explicit
Dim IE As InternetExplorer
Dim SearchString As String
Dim StartChar As Double
Dim EndChar As Double
Dim URL As String
Dim AdURL As String
Dim RightAdUrl As String
Dim LeftAdUrl As String
Sub SeLogerGrabData()
Dim IE As InternetExplorer
 
Dim SearchString As String
Dim StartChar As Double
Dim EndChar As Double
 
Dim URL As String
Dim AdURL As String
Dim RightAdUrl As String
Dim LeftAdUrl As String
 
Dim HTMLdoc As HTMLDocument
Dim SpanElements As IHTMLElementCollection
Dim SpanElement As HTMLSpanElement
 
Dim AdHTMLdoc As HTMLDocument
Dim AdDivElements As IHTMLElementCollection
Dim AdDivElement As HTMLDivElement
 
Dim r As Long
 
Dim s As Long
 
RightAdUrl = "http://www.seloger.com"
 
URL = RightAdUrl & "/immobilier/achat/immo-paris-75/bien-appartement/#pxbtw:NaN;NaN/surfacebtw:NaN;NaN/idtt:2/nb_pieces:all/idtypebien:3/:/nb_chambres:all/tri:d_dt_crea/fakeci:750056/ci:750101,750102,750103,750104,750105,750106,750107,750108,750109,750110,750111,750112,750113,750114,750115,750116,750117,750118,750119,750120/idqfix:1/BCLANNpg:1" 'place your desired URL here
Set IE = New InternetExplorer
With IE
    .navigate URL
    .Visible = False
    'Wait for page to load
    While .Busy = True Or .readyState <> READYSTATE_COMPLETE
    DoEvents
    Wend
    Set HTMLdoc = .document
End With
Application.Wait (Now + TimeValue("0:00:15"))
Set SpanElements = HTMLdoc.getElementsByTagName("span")
    Sheets("Feuil1").Cells.ClearContents
    r = 0
    For Each SpanElement In SpanElements
        If SpanElement.className = "mea1" Then
               ' Sheets("Feuil1").Range("A1").Offset(r, 0).Value = DivElement.innerHTML
               ' r = r + 1
            SearchString = SpanElement.innerHTML
            StartChar = InStr(1, SearchString, "href=", vbTextCompare) + 6
            EndChar = InStr(1, SearchString, ">Parking", vbTextCompare) - StartChar - 1
            AdURL = RightAdUrl & Mid(SearchString, StartChar, EndChar)
              Set IE = New InternetExplorer
            With IE
                .navigate AdURL
                .Visible = False
                'Wait for page to load
                While .Busy = True Or .readyState <> READYSTATE_COMPLETE
                DoEvents
                Wend
                Set AdHTMLdoc = .document
            End With
            Application.Wait (Now + TimeValue("0:00:05"))
            Set AdDivElements = AdHTMLdoc.getElementsByTagName("div")
 
            For Each AdDivElement In AdDivElements
                 Select Case AdDivElement.ID
                    Case Is = "h1_detail"
                        SearchString = AdDivElement.innerHTML
                        s = 1
                        StartChar = 1
                        EndChar = 5
                        Do Until IsNumeric(Mid(SearchString, StartChar, EndChar)) = True
                            StartChar = InStr(s, SearchString, "<SPAN>", vbTextCompare) + 6
                            s = StartChar
                        Loop
                        Sheets("Feuil1").Range("a1").Offset(r, 1).Value = Mid(SearchString, StartChar, EndChar)
                    Case Is = "det_descriptif_ann"
                        Sheets("Feuil1").Range("A1").Offset(r, 2).Value = AdDivElement.innerText
                    Case Is = "gmap_detail"
                        SearchString = AdDivElement.innerHTML
                        StartChar = InStr(1, AdDivElement.innerHTML, "Quartier", vbTextCompare) + 9
                        EndChar = InStr(1, AdDivElement.innerHTML, "</H4>", vbTextCompare) - StartChar
                        Sheets("Feuil1").Range("A1").Offset(r, 3).Value = Mid(SearchString, StartChar, EndChar)
                    Case Is = "situation_mm_metro"
                        Sheets("Feuil1").Range("A1").Offset(r, 4).Value = AdDivElement.innerText
                End Select
            Next
 
        r = r + 1
    End If
    Next
    MsgBox ("done")
End Sub
Cela fonctionne plutot pas mal, mais c'est un peu lent. Malheureusement, je n'ai pas trouvé d'autre moyen que
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Application.Wait (Now + TimeValue("0:00:15"))
pour détourner le bug lié à IE...

Avez-vous des idées à partager pour augmenter la vitesse d'éxécution de ce code ?

Merci beaucoup.