Discussion :

[alexmaroye]

Cher Forum,

Je me forme au VBA et je rencontre certaines difficultes lors de l'extraction de donnees depuis une page web. Merci d'avance pour votre temps et conseil

Voici une description de la situation:

1) Le probleme

La difficulte la plus importante consiste a recuperer les urls d'une page web.

Pour etre precis, je souhaite recuperer tous les urls des annonces immobilieres contenues dans cette page: http://dubai.dubizzle.com/property-f...rty_developer=

Pour affiner le scope de la recherche, je cherche en realite a extraires les urls contenu dans <div id="results-list.

Les urls se presentent sous la forme:<ahref=""http://dubai.dubizzle.com/property-for-rent/residential/villahouse/2014/5/23/family-villa-vacant-3-bedroom-study-maids--2/?back=ZHViYWkuZHViaXp6bGUuY29tL3Byb3BlcnR5LWZvci1yZW50L3Jlc2lkZW50aWFsLz9wcmljZV9fZ3RlPSZwcmljZV9fbHRlPSZiZWRyb29tc19fZ3RlPTAmYmVkcm9vbXNfX2x0ZT0xMiZwbGFjZXNfX2lkX19pbj1TdGFydCt0eXBpbmcraGVyZSZwbGFjZXNfX2lkX19pbj0mYnVpbGRpbmdfX2luPVN0YXJ0K3R5cGluZytoZXJlJmtleXdvcmRzPSZpc19iYXNpY19zZWFyY2hfd2lkZ2V0PTAmaXNfc2VhcmNoPTEmYWRkZWRfX2d0ZT0mY29tcGFueV9pdGVtX2lkPSZmdXJuaXNoZWQ9Jmxpc3RlZF9ieT0mc2l6ZV9fZ3RlPSZzaXplX19sdGU9JmJhdGhyb29tc19fZ3RlPSZiYXRocm9vbXNfX2x0ZT0mcmVhbF9lc3RhdGVfYWdlbnQ9JmxhbmRsb3JkPSZwcm9wZXJ0eV9kZXZlbG9wZXI9&amp;pos=1""xtcltype=""S""xtclib=""listing_list_1_title_link"">Familyvilla-vacant-3bedroom+study+maids-...</a>


L'objectif est donc de lister dans une colonne excel, l'ensemble des urls.

2) La macro actuelle
Pour le moment, j'ai cree une macro qui recupere dans un cellule le contenu html contenu dans "results-list:

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
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
url_name = "http://dubai.dubizzle.com/property-for-rent/residential/?price__gte=&price__lte=&bedrooms__gte=0&bedrooms__lte=12&places__id__in=Start+typing+here&places__id__in=&building__in=Start+typing+here&keywords=&is_basic_search_widget=0&is_search=1&added__gte=&company_item_id=&furnished=&listed_by=&size__gte=&size__lte=&bathrooms__gte=&bathrooms__lte=&real_estate_agent=&landlord=&property_developer="
'"www.google.fr" '
IE.navigate (url_name)
 
Do
DoEvents
Loop Until IE.readyState = 4
 
myLinks = Replace(IE.document.getElementsByTagName("div")("results-list").innerHTML, " ", "") 
 
Cells(1,1) = myLinks
 
End Sub

je suis bloque a ce niveau.

3) Des pistes pour atteindre l'objectif ?

J'ai lu pas mal de tuto / forum / videos youtube et il ressort qu'il serait possible d'extraire l'ensemble des urls avec un code de ce genre - toutefois, je n'ai pas reussi a l'appliquer a mon cas:

Code :

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

1
2
3
4
5
6
' La page est deja chargee
 
Set Allhyperlinks = ie.documentByTagName("a")
For each hyper_link in Allhyperlinks
Sheets1.Listbox1.AddItem (hyper_links)
Next

J'espere avoir ete suffisament precis dans l'expose du cas. N'hesitez pas a demander des precisions si besoin.
Merci d'avance pour votre temps/conseils.

Alex

[Marc-L]

Bonjour, bonjour,

merci d'utiliser l'icône # dédiée au balisage du code conformément aux règles du forum,
cela aurait certainement favorisé des intervenants à répondre plus tôt …

Avant d'attaquer le VBA, de bonnes notions en langage HTML sont nécessaires afin de décoder la page Web source,
ne pas hésiter à utiliser l'outil d'inspection intégré aux navigateurs …

Deux possibilités pour extraire les liens :

• fonctions texte parmi la batterie intégrée au VBA comme Instr, Mid, Split, …

• Méthodes d'un navigateur ou de bibliothèques web. (consulter le forum Contribuez pour IE, sinon documentation sur le site MSDN)

Cette dernière est utilisée dans l'exemple suivant (mieux vaut se passer de piloter Internet Explorer si possible),
code à copier directement dans le module de la feuille recevant les liens en raison du bonus du double-clic :

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
Sub Demo()
    Const URL$ = "http://dubai.dubizzle.com/property-for-rent/residential/?bedrooms__gte=0&" & _
                 "bedrooms__lte=12&places__id__in=Start+typing+here&" & _
                 "building__in=Start+typing+here&is_basic_search_widget=0&is_search=1"
 
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", URL, False:  .send:  If .Status = 200 Then T$ = .responseText
    End With
 
    If T > "" Then
        With CreateObject("HTMLFile")
            .Write T
 
            With .GetElementById("results-list").GetElementsByTagName("h3")
                        ReDim AR$(1 To .Length, 1 To 1)
                For N& = 1 To .Length
                    T = .Item(N - 1).GetElementsByTagName("a")(0).href:  P& = InStr(T, "?")
                    If P Then AR(N, 1) = Left$(T, P - 1) Else AR(N, 1) = T
                Next
 
                [A1].CurrentRegion.Clear:  [A1].Resize(.Length).Value = AR
            End With
        End With
    End If
 
    End
End Sub
 
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Left(Target.Value, 7) = "http://" Then
        Cancel = True
        On Error Resume Next
        ThisWorkbook.FollowHyperlink Target.Value
    End If
End Sub

_______________ ____________________________________ ______________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …