Bonjour à tous
je suis encore présent
Du coup pour éviter de données un fichier dit confidentiel, je vais vous proposer ceci
Je résume donc mes propos
je fais une extraction via API pipedrive "ok je sais pas terrible"
et du coup je me retrouve avec ce type de code qui a été modifié mais en gardant les mêmes nombres de caractères.
{"success":true,"data":{"items":[{"result_score":0.428245,"item":{"id":*****,"type":"organization","
name":"
ADE - Atglixrs Dvs Groves","
address":"************","visible_to":3,"owner":{"id":***********},"custom_fields":["
https://www.********.com/,
www.********.com","Atglixrs Dvs Groves","********
@********","Bails ProtovoltqÏque","Fournisseurs \r\nCrmtailwaet"],"notes":[]}},{"result_score":0.21967,"item":{"id":****,"type":"
person","name":"
Palu","
phones":["00 00 00 00 00"],"
emails":["********
@********.com"],"visible_to":3,"owner":{"id":**********},"organization":null,"custom_fields":["
https://www.linkedin.com/*********/"],"notes":[]}}]},"additional_data":{"pagination":{"start":0,"limit":100,"more_items_in_collection":false}}}
et au final je voudrais que cela se décline dans un tableau qui ressemblerait à ca
| Fournisseur | XXX |
| Adresse | |
| Téléphone | 00 00 00 00 |
| nom du contact | hgghghhg |
| Mail scté | hgghghhg@hgg.com |
du coup j'ai ceci comme code il fonctionne mais je souhaiterai le simplifié
Codage VBA
Option Explicit
Sub RecupDonnees()
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String 'Chaine de caractère réponse de l'API PipeDrive
Dim strAdresse As String 'Adresse de l'entreprise
Dim strPhones As String
Dim strAdress As String ' ville ou commune de l'entreprise
Dim strNom As String 'nom du contact
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "
https://**************************=" & ThisWorkbook.ActiveSheet.Cells(1, 2).Value
blnAsync = True
With objRequest
.Open "GET", strUrl, blnAsync
.setRequestHeader "Content-Type", "application/json"
.send
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .responseText
End With
'Recherche de l'adresse
If InStr(strResponse, "address") <> 0 Then
strAdresse = Right(strResponse, Len(strResponse) - InStr(strResponse, "address") - 9)
strAdresse = Left(strAdresse, InStr(strAdresse, """") - 1)
ThisWorkbook.ActiveSheet.Cells(2, 2).Value = strAdresse
Else
ThisWorkbook.ActiveSheet.Cells(2, 2).Value = "Adresse non trouvée"
End If
'Recherche téléphone
If InStr(strResponse, "phones") <> 0 Then
strPhones = Right(strResponse, Len(strResponse) - InStr(strResponse, "phones") - 9)
strPhones = Left(strPhones, InStr(strPhones, """") - 1)
ThisWorkbook.ActiveSheet.Cells(4, 2).Value = strPhones
Else
ThisWorkbook.ActiveSheet.Cells(4, 2).Value = "téléphone non trouvée"
End If
'Recherche ville
If InStr(strResponse, "address") <> 0 Then
strAdress = Right(strResponse, Len(strResponse) - InStr(strResponse, "address") - 36)
strAdress = Left(strAdress, InStr(strAdress, """") - 1)
ThisWorkbook.ActiveSheet.Cells(3, 2).Value = strAdress
Else
ThisWorkbook.ActiveSheet.Cells(3, 2).Value = "Adresse non trouvée"
End If
'nom du contact
If InStr(strResponse, "person") <> 0 Then
strNom = Right(strResponse, Len(strResponse) - InStr(strResponse, "person") - 15)
strNom = Left(strNom, InStr(strNom, """") - 1)
ThisWorkbook.ActiveSheet.Cells(5, 2).Value = strNom
Else
ThisWorkbook.ActiveSheet.Cells(5, 2).Value = "Nom non trouvée"
End If
Debug.Print strResponse
End Sub
Je vous remercie infiniment tous pour le temps que vous consacrerez à étudier mon dossier et pour les solutions que vous m'apporterez
Cordialement