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 |
