Microsoft 365 Excel et Insee

[natzai]

Bonjour,
En début d'année j'avais réussi à trouver ces documents (ci-joints) qui me permettaient de trouver par le nom de la société et son département tous les sites qui lui étaient rattachés. Le 2eme onglet rapatrie les éléments si on connait le SIRET.
Je viens d'essayer de le réutiliser mais il ne fontionne plus.
- Je ne sais plus où je l'avais eu (peut-être de l'insee)
- Je n'ai pas d'application donc je ne peux pas télécharger d'api Insee

=> Mon besoin complet :
Pouvoir retrouver les sirets, noms de la structure/enseigne, l'adresse complète son statut (ouvert/fermé) de toutes les agences d'une société avec comme unique information UN SIREN

En espérant que quelqu'un puisse m'aider et vous remerciant par avance

 

[sylvanu]

Bonjour Natzai,
Votre VBA a un mot de passe, donc inaccessible.
Votre lien "Vérifier les SIRET en masse" renvoie à https://www.dophis.fr/produit/verifier-siret-en-masse/ qui propose l'achat d'un outil d'accès.
Votre lien "Base SIRENE" renvoie a https://www.sirene.fr/sirene/public/accueil qui n'est pas accessible.
Les liens sont apparemment devenus obsolètes.

Donc je ne pense pas qu'un contributeur puisse vous aider sauf à reconstruire l'outil.

 

[crocrocro]

Bonjour @natzai , @sylvanu
@sylvanu Voici un lien vers la base Sien accessible depuis OpenDataSoft https://data.opendatasoft.com/explo...legale&disjunctive.naturejuridiqueunitelegale
J'ai eu l'occasion d'y accéder dans Excel ((ainsi que d'autres bases accessibles depuis OpenDataSoft)

 

[sylvanu]

Bonjour Crocrocro,
Cela revient donc à reprendre l'outil.

 

[crocrocro]

Bonjour Crocrocro,
Cela revient donc à reprendre l'outil.

Il semblerait bien.
J'ai ouvert le fichier pour essayer de voir le code et comme vous l'avez signalé, il est protégé par mot de passe.
L'outil ressemble dans ses grandes lignes à un outil que j'ai créé il y a quelques temps qui interroge les bases accessibles dans OpenDataSoft dont l'application d'interrogation en ligne n'est pas très ergonomique dès lors qu'on veut poser des filtres. Avec interrogation, par exemple avec Excel, l'extraction est bloquée (c'est normal) à 100 lignes par appel. çà complique un peu l'extraction.
Voir ce lien VBA manipulation d'objets suite à réception fichier JSON et merci encore à @ERIC S , tatiak qui m'ont permis, à partir de leur code d'élaborer ma propre recette.

 

[crocrocro]

bonjour le fil,
quelques remarques concernant le code de tatiak proposé par @p56 :
comme je l'ai dit dans mon mon post précédent

l'extraction est bloquée (c'est normal) à 100 lignes par appel

Dans le code proposé la limite a été définie à 20 (records?limit=20)

Public Const SIRENEV3 = "https://data.opendatasoft.com/api/explore/v2.1/catalog/datasets/economicref-france-sirene-v3@public/records?limit=20&refine=siren%3A"

Si le nombre d'enregistrements correspondant au(x) critère(s) de recherche est > 20, les suivants ne seront pas remontés.
Dans l'exemple avec n° de Siren = 263800302, on remonte 20 enregistrements, mais il y en a en réalité 50.
Il faut positionner records?limit=100. Pas plus car, avec le code, l'erreur ne sera pas interceptée et on ne remontera aucun enregistrement.
Et cela se corse donc si pour un Siren on a plus de 100 enregistrements.
Il faut faire plusieurs appels en jouant sur le paramètre /records?start=rows=0 de la requête envoyée (0 au 1er appel, 100 au suivant ...).

EDIT :
Voici le code modifié qui permet ici de boucler sur tous les enregistrements correspondant au(x) critère(s) de recherche.
Pour passer dans la boucle, j'ai volontairement indiqué une limite à 20 et non 100 (/records?start=&rows=20)

- la constante SIRENEV3

'Public Const SIRENEV3 = "https://data.opendatasoft.com/api/explore/v2.1/catalog/datasets/economicref-france-sirene-v3@public/records?limit=10&refine=siren%3A"
Public Const SIRENEV3 = "https://data.opendatasoft.com/api/explore/v2.1/catalog/datasets/economicref-france-sirene-v3@public"

- la Sub Import_Jsn

Sub Import_Jsn()
Dim Bdd As ListObject, lg As Integer, Td As Variant, Lig As Long
Dim Rcd As Object, Rlst As Object, Elm As Object, i As Integer
Dim Fin As Boolean
Dim Url As String
Dim EnregStart As Long
Dim EnregPrec As Long
Dim UrlDataSet As String
Dim DataSet As String
    On Error Resume Next
    Set Bdd = Range("Ts_Siren").ListObject
    If Bdd.ListRows.Count > 0 Then
        For lg = 1 To Bdd.ListRows.Count
            EnregStart = 0
            EnregPrec = 0
            Fin = False
            While Not Fin
                EnregStart = EnregPrec
                'UrlDataSet = SIRENEV3 & DataSet & "/records?start=&rows=100&refine=siren%3A"
                UrlDataSet = SIRENEV3 & DataSet & "/records?start=&rows=20&refine=siren%3A"
                Url = Replace(UrlDataSet, "start=", "start=" & EnregStart)
                'Set Rcd = HTML(SIRENEV3 & Bdd.DataBodyRange(lg, 1).Value)
                Set Rcd = HTML(Url & Bdd.DataBodyRange(lg, 1).Value)
                If Not Rcd Is Nothing Then
                    Set Rlst = VBA.CallByName(Rcd, "results", VbGet)
                    ReDim Td(1 To Rcd.total_count, 1 To 8)
                    'For i = 0 To Rcd.total_count - 1
                    i = 0
                    Do
                        Set Elm = VBA.CallByName(Rlst, i, VbGet)
                        Td(i + 1, 1) = Bdd.DataBodyRange(lg, 1).Value
                        Td(i + 1, 2) = Elm.siret
                        Td(i + 1, 3) = Elm.denominationunitelegale
                        Td(i + 1, 4) = Elm.enseigne1etablissement
                        Td(i + 1, 5) = Elm.numerovoieetablissement & " " & _
                                        Elm.typevoieetablissement & " " & _
                                        Elm.libellevoieetablissement
                        Td(i + 1, 6) = Elm.codepostaletablissement
                        Td(i + 1, 7) = Elm.libellecommuneetablissement
                        Td(i + 1, 8) = IIf(IsNull(Elm.datefermetureunitelegale), "OUI", "NON")
                        i = i + 1
                    'Next i
                    Loop Until i > Rcd.total_count And Not IsError(VBA.CallByName(Rlst, i, VbGet))
                    Lig = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row + 1
                    ActiveSheet.Range("E" & Lig).Resize(UBound(Td, 1), UBound(Td, 2)) = Td
                    EnregPrec = EnregStart + i
                    If EnregPrec >= Rcd.total_count Then Fin = True
                Else
                    Fin = True
                End If
            Wend
        Next lg
    End If
    Exit Sub
End Sub

 

[crocrocro]

Le post de @p56 a disparu , supprimé ?
Je joins donc un fichier qui reprend le code qu'il avait posté (il n'avait pas posté de fichier) qui contient mes modifications indiquées dans le post précédent.