Discussion :

[boubou26]

Bonjour tous,
je suis nouveau sur le site ! et j'ai besoin d'aide quant a l'élaboration d'une macro sous excel qui me permettrai de faire des recherches sur un site web (societe.com) à partir d'un numéro siren. Je n'arrive pas a automatiser la maquette... aider moi svp !

ps : ci joint le début de mon fichier
ps 2 : l'info qu'il me faut se situe au niveau : décision de justice (lorsqu'il y en a une)

[pc75]

Bonjour,

A quel endroit on voit "décision de justice" ?

[Denis la Malice]

Bonjour,
je vois que tu as le début d'un commencement d'approche. Je te propose une autre méthode plus simple.
Quand tu analyses le code source de la page "www.societe.com" tu vois que le formulaire de recherche utilise la méthode GET avec un appel à "/cgi-bin/mainsrch/" et un paramètre "champ" qui contient le Siren débarrassé des espaces et autres caractères superflus. Seuls 9 chiffres sont autorisés.
L'URL a saisir est donc : http://www.societe.com/cgi-bin/mains...hamp=480753482 pour le siren "480 753 482" (qui correspond a un margoulin qui a 3 décisions de justice).

Je pense que saisir le Siren et le mettre en forme et le contrôler est facile.
Construire l'URL est également facile.

Maintenant, pour récupérer le contenu de la page, je te suggère la méthode suivante :

• Cherche si tu as une feuille "Temp" et détruit-la si elle existe.
• Crée une feuille "Temp"
• Lance l'enregistreur de macro
• Ajoute une liaison Web (Données --> A partir du Web)
• Met l'URL définie ci-dessus.
• Lance une recherche sur la chaine "Décision de justice"
• Arrête l'enregistrement de la macro

Tu as alors tous les éléments pour construire ta macro.
Bon courage, il te reste encore un peu de boulot.

Tiens nous au courant de tes avancées et n'hésite pas à poser d'autres questions si tu ne t'en sors pas.

[pc75]

Re,

La suite :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
    IE.Navigate "http://www.societe.com/societe/euro-builders-480753482.html"
    IE.Visible = True
 
    WaitIE IE
    contenu = IE.document.DocumentElement.innerText
    Debut = InStr(contenu, "Depuis")
    Fin = InStr(Debut, contenu, "Masquer")
    result = Mid(contenu, Debut, Fin - Debut)
    MsgBox result
    Set IE = Nothing
    Set IEDoc = Nothing

[boubou26]

Bonjour à tous,
Merci pour votre début de réponse. Ce que tu me demande DENIS LA MALICE c'est du chinois pour moi... en faite je suis contrôleur de gestion avec quelques notion mais rien de bien concret pour faire ce genre d'outil.
Je comprend le raisonnement par contre je suis incapable de le faire.
Pourrais tu me dire comment faire ?

Merci par avance.

Cdt
boubou26

Bonjour Pc75,

Super ton code fonctionne ! le resultat s'affiche dans un userform.
Par contre si j'ai une liste comment faire pour qu'il me mette l'info en face de numero SIREN ?

Merci par avance pour ton aide.

Cdt
boubou26

[pc75]

Re,

Bonjour Pc75,

Super ton code fonctionne ! le resultat s'affiche dans un userform.
Par contre si j'ai une liste comment faire pour qu'il me mette l'info en face de numero SIREN ?

Merci par avance pour ton aide.

Cdt
boubou26

Tu peux préciser ta question, stp ?

[Denis la Malice]

Bonjour,

utilise un code comme celui-ci pour mettre les résultats dans la deuxième colonne :

Code :

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

1
2
3
4
5
6
7
8
9
Sub RemplirInfo()
    Dim Ligne As Integer
 
    Ligne = 2
    While Cells(Ligne, 1) <> ""
        Cells(Ligne, 2) = RechercheInfo(Cells(Ligne, 1))
        Ligne = Ligne + 1
    Wend
End Sub

Remplace ta procédure par une fonction en la déclarant comme ceci :

Code :

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

Function RechercheInfo(Siren As String)

Modifie le code pour ne pas afficher le résultat mais le renvoyer :

Code :

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

1
2
' Msgbox result
RechercheInfo = result

Améliore ta fonction de recherche de résultat pour prendre en compte les cas où il n'y a pas de décision de justice, par exemple.

[boubou26]

Bonjour tous,

Je reviens vers vous car j'ai besoin de votre aide !
j'ai besoin d'aide quant a l'élaboration d'une macro sous excel qui me permettrai de faire des recherches sur un site web (societe.com) à partir d'un numéro siren. Je n'arrive pas a automatiser la maquette... aider moi svp !

ps : ci joint le début de mon fichier
ps 2 : l'info qu'il me faut se situe au niveau "activité"

Merci a tous pour votre aide.

cordialement
boubou26

[Marc-L]

Bonjour,

ton code a l'air de bien fonctionner, c'est peut-être qu'il n'y a pas de renseignement sur la page source …

Dans le doute, refaire la QueryTable manuellement sur un classeur vierge
pour vérifier exactement quelle cellule contient l'information …


__________________________________________________________________________________________

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

[Marc-L]

La QueryTable fonctionne effectivement bien …

J'allais te demander de publier ton code afin de t'expliquer les deux grosses boulettes des lignes n°58 & 64
(pédagogique pour toi et d'autres afin de vous guider vers l'autonomie)
lorsque j'ai compris que ce sujet était en fait un doublon et qu'y plus est tu as fait une demande en MP dans ton sujet d'origine :

Recherche info sur page WEB via macro VB …


Pas la peine donc de publier ma solution tenant en 35 lignes de code …

[Denis la Malice]

Bonjour,
le site Web de societe.com a évolué. Le code pour l'interroger aussi.

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Sub RemplirInfo()
    Dim Ligne As Integer
 
    Ligne = 2
    While Cells(Ligne, 1) <> ""
        Cells(Ligne, 2) = "..."
        Cells(Ligne, 2) = RechercheInfo(Cells(Ligne, 1))
        DoEvents
        Ligne = Ligne + 1
 
    Wend
    Columns.EntireColumn.AutoFit
End Sub
 
Function RechercheInfo(Siren As String) As String
        Dim Feuille As Worksheet, Cellule As Range, Erreur As Long, Description As String
 
        Siren = Replace(Siren, " ", "")
        Siren = Replace(Siren, Chr(160), "")
 
        ' Valeur de retour par défaut (ça ne sert à rien, mais j'ai appris qu'il fallait toujours initialiser ses variables).
        RechercheInfo = "Je n'ai rien trouvé"
        ' Destruction de l'onglet "Temp" s'il existe
        For Each Feuille In ActiveWorkbook.Sheets
               If Feuille.Name = "Temp" Then
                    Application.DisplayAlerts = False   ' Pour éviter le message de confirmation de destruction
                    Sheets("Temp").Delete
                    Application.DisplayAlerts = True
                    Exit For
               End If
        Next Feuille
        ' Creation de la feuille temporaire
        Sheets.Add.Name = "Temp"
        Sheets("SIREN").Activate
        ' Creation de la connexion Web
     With Sheets("Temp")
 
     ' Maintenant le site renvoie une erreur 404 si le SIERN n'existe pas. Ce qui génère une erreur et "plante" la macro.
     On Error Resume Next
 
          With .QueryTables.Add(Connection:= _
               "URL;http://www.societe.com/cgi-bin/fiche/?rncs=" & Siren, _
                    Destination:=Sheets("Temp").Cells(1, 1))
               .Name = Siren
               .FieldNames = True
               .RowNumbers = False
               .FillAdjacentFormulas = False
               .PreserveFormatting = False
               .RefreshOnFileOpen = False
               .BackgroundQuery = False
               .RefreshStyle = xlInsertDeleteCells
               .SavePassword = False
               .SaveData = True
               .AdjustColumnWidth = True
               .RefreshPeriod = 0
               .WebSelectionType = xlEntirePage
               .WebFormatting = xlWebFormattingNone
               .WebPreFormattedTextToColumns = True
               .WebConsecutiveDelimitersAsOne = True
               .WebSingleBlockTextImport = False
               .WebDisableDateRecognition = False
               .WebDisableRedirections = False
               .Refresh BackgroundQuery:=False
          End With
 
          ' Il faut récupérer le contenu de Err avant de faire le "On Error Goto 0" qui réinitiallise Err.
          Erreur = Err.Number
          Description = Err.Description
 
          On Error GoTo 0
 
          ' Vérification de l'existance d'une réponse
          If Erreur = 0 Then
               ' Pas d'erreur en interrogeant le site
          ElseIf Erreur = 1004 Then
               RechercheInfo = "Le numéro Siren n'existe pas."
               Exit Function
          Else
               RechercheInfo = "Erreur d'interrogation du site."
               Exit Function
          End If
 
        ' Recherche des décisions de justice
        ' ATTENTION la recherche porte sur la totalité de la cellule (LookAt:=xlWhole) pour ne pas être
        ' perturbé par toutes les cellule qui contiennent le mot "jugement".
        Set Cellule = .Cells.Find(What:="Jugement", After:=.Cells(1, 1), LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
        If Cellule Is Nothing Then
            RechercheInfo = "(Pas de décision de justice) -"
        Else
            RechercheInfo = Cellule.Offset(0, 1).Value & " -"
        End If
 
        ' Recherche des entreprises radiées
        Set Cellule = .Cells.Find(What:="Entreprise radiée", After:=.Cells(1, 1), LookIn:= _
            xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
        If Not Cellule Is Nothing Then
            RechercheInfo = RechercheInfo & " [" & Cellule.Value & "]"
        End If
        ' Recherche de l'activité
        Set Cellule = .Cells.Find(What:="Activité (Code NAF ou APE)", After:=.Cells(1, 1), LookIn:= _
            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
        If Not Cellule Is Nothing Then
            RechercheInfo = RechercheInfo & " Activité = " & Cellule.Offset(0, 1).Value
        End If
 
        Set Cellule = Nothing
 
    End With
 
    Application.DisplayAlerts = False
    Sheets("Temp").Delete
    Application.DisplayAlerts = True
 
End Function