Erreur API avec authentification

Bonjour,

Je débute en codage VBA.

J'ai réalisé un code pour intégrer une recherche par API avec une authentification sauf que j'ai toujours la même erreur :
Erreur d'exécution '-2146893019 (10090325)':
La chaîne de certificats a été fournie par une autorité qui n'est pas approuvée.

Mon code bloque à cette ligne : httpReq.send

Je vous avoue que je ne comprends pas...

Merci d'avance

Bonjour,

Avec l'intégralité du code on y verrait surement plus clair. ;)

Cordialement,

Oui voilà le code en entier :

Code:

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
Function CallLaPosteAPI(ByVal CODE As String) As Dictionary
    Dim apiEndpoint As String
    Dim response As String
    Dim jsonObject As Object
    Dim jsonDict As New Dictionary ' Assurez-vous que la bibliothèque "Microsoft Scripting Runtime" est ajoutée à votre projet
 
    apiEndpoint = "https://api.laposte.fr/suivi/v2/idships/" & CODE & "?lang=fr_FR"
 
    ' Spécifiez l'adresse IP à utiliser dans l'en-tête "X-Forwarded-For"
    Dim adresseIP As String
    adresseIP = "194.250.231.149" ' Remplacez par l'adresse IP souhaitée
 
    ' Exécutez la commande cURL depuis la ligne de commande
    Dim cURLCommand As String
    cURLCommand = "curl -H ""Content-Type: application/json"" -H ""X-Okapi-Key: mFOgr8KhMegIb+OkIrcC5U0BlaBlaBla"" -X GET """ & apiEndpoint & """"
 
    ' Exécutez la commande cURL et capturez la réponse
    response = ExecuterCommandeShell(cURLCommand)
 
    ' Imprimez la réponse dans la fenêtre "Immediate" pour le débogage
    Debug.Print response
 
    ' Vérifier si la commande cURL a réussi
    If response Like "*HTTP/1.1 200 OK*" Then
        ' Supprimez les en-têtes HTTP de la réponse
        response = ExtraireContenuJSON(response)
 
        ' Utiliser la bibliothèque VBA-JSON pour analyser la réponse JSON
        Set jsonObject = JsonConverter.ParseJson(response)
 
        ' Ajouter les données extraites du JSON à votre dictionnaire
        For Each Key In jsonObject.Keys
            jsonDict(Key) = jsonObject(Key)
        Next Key
 
        ' Retourner le dictionnaire avec les données JSON
        Set CallLaPosteAPI = jsonDict
    Else
        ' En cas d'échec, retourner Nothing
        Set CallLaPosteAPI = Nothing
    End If
End Function
 
Function ExecuterCommandeShell(Commande As String) As String
    Dim objShell As Object
    Dim objExec As Object
    Dim sortie As String
 
    Set objShell = CreateObject("WScript.Shell")
    Set objExec = objShell.Exec(Commande)
 
    sortie = objExec.StdOut.ReadAll
    ExecuterCommandeShell = sortie
End Function
 
Function ExtraireContenuJSON(response As String) As String
    Dim startIndex As Long
    Dim endIndex As Long
 
    startIndex = InStr(response, "{")
    endIndex = InStrRev(response, "}")
    If startIndex > 0 And endIndex > 0 Then
        ExtraireContenuJSON = Mid(response, startIndex, endIndex - startIndex + 1)
    Else
        ExtraireContenuJSON = ""
    End If
End Function