Bonjour à tous,

Je suis nouveau sur ce forum que j'ai rejoins car je bloque sur un développement depuis quelques temps.
Je souhaite en effet uploader un fichier PDF sur un serveur depuis Excel grâce à une API. Le serveur sur lequel je souhaite uploader le fichier est un serveur d'entreprise (serveur AWS S3).
La situation est la suivante : j'ai créé un outil Excel qui crée des documents PDF. Je souhaite pouvoir les uploader sur le serveur de cette entreprise et récupérer le lien afin de le partager par la suite au travers d'une communication envoyée par mail directement depuis Excel. Le service que propose cette entreprise est d'effectuer des scorings d'intérêt sur les documents hébergés sur le serveur.

Le code que je vous joins permet d'envoyer 4 requêtes sur le serveur : une première pour récupérer le Token d'identification, une deuxième pour obtenir des informations sur l'hébergement, une troisième pour créer un nouveau projet et la dernière pour finalement envoyer le PDF sur le serveur et l'intégrer au projet créé préalablement.

Toutes ces requêtes fonctionnent, mon fichier s'upload bien sur le serveur et se loge bien dans le projet crée pour l'occasion. En revanche lorsque j'essaie d'ouvrir le document sur le serveur, il est illisible. Je suppose donc que dans ma 4ème requête, je n'envoie pas les bonnes informations dans le body de la requête.

Voici le code que j'utilise actuellement :

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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
Sub En_construction()
 
'Variables générales
Dim Token As String
Dim Wsh, CheminBureau As String
 
Set Wsh = CreateObject("WScript.Shell")
CheminBureau = Wsh.SpecialFolders("Desktop") & "\"
 
'Variables Requête 1
Dim Requête As Object
Dim URL As String
Dim Réponse As Object
 
'Envoi de la requête 1 (Récupération du Token d'authentification)
Set Requête = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "URLDUSERVEUR"
 
    With Requête
    .Open "POST", URL, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send "username=MONUSERNAME&password=MONPASSWORD&grant_type=password"
    End With
 
'Vérification du statut de la requête 1
    If Requête.Status = 200 Then
    DoEvents
    Else
    MsgBox Requête.Status & " " & Requête.statusText, , "Statut renvoyé par le serveur - requête 1"
    End If
 
'Récupération et traitement du Token retourné par la requête 1
Set Réponse = JsonConverter.ParseJson(Requête.responseText)
Debug.Print Réponse("access_token")
Token = Réponse("access_token")
 
'Variables Requête 2
Dim Requête2 As Object
Dim URL2 As String
Dim Réponse2 As Object
 
'Envoi de la requête 2
Set Requête2 = CreateObject("WinHttp.WinHttpRequest.5.1")
URL2 = "URLDUSERVEUR2"
 
    With Requête2
    .Open "GET", URL2, False
    .setRequestHeader "Authorization", "Bearer " & Token
    .setRequestHeader "Content-Type", "application/json"
    .send
    End With
 
'Vérification du statut de la requête 2
    If Requête2.Status = 200 Then
    DoEvents
    Else
    MsgBox Requête2.Status & " " & Requête2.statusText, , "Statut renvoyé par le serveur - requête 2"
    End If
 
'Récupération et traitement des informations retournées par la requête 2
Set Réponse2 = JsonConverter.ParseJson(Requête2.responseText)
Debug.Print Réponse2("key")
Debug.Print Réponse2("acl")
Debug.Print Réponse2("policy")
Debug.Print Réponse2("signature")
Debug.Print Réponse2("AWSAccessKeyId")
Debug.Print Réponse2("success_action_status")
 
Const PATH = "CHEMINDUPDFAENVOYER"
Const fileName = "test.pdf"
Const CONTENT = "application/pdf"
Const URL3 = "URLSERVEUR3"
 
'Generate boundary
Dim Boundary, S As String, n As Integer
For n = 1 To 16: S = S & Chr(65 + Int(Rnd * 25)): Next
Boundary = S & CDbl(Now)
 
Dim part As String, ado As Object
 
Set oFields = CreateObject("Scripting.Dictionary")
    With oFields
        .Add "key", Réponse2("key")
        .Add "acl", Réponse2("acl")
        .Add "policy", Réponse2("policy")
        .Add "signature", Réponse2("signature")
        .Add "AWSAccessKeyId", Réponse2("AWSAccessKeyId")
        .Add "success_action_status", Réponse2("success_action_status")
    End With
 
part = ""
    For Each sName In oFields
        part = part & "--" & Boundary & vbCrLf
        part = part & "Content-Disposition: form-data; name=""" & sName & """" & vbCrLf & vbCrLf
        part = part & oFields(sName) & vbCrLf
    Next
        part = part & "--" & Boundary & vbCrLf
        part = part & "Content-Disposition: form-data; name=""file""; filename=""" & fileName & """" & vbCrLf
        part = part & "Content-Type: " & CONTENT & vbCrLf & vbCrLf
 
    ' read file into image
    Dim image
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 'binary
    ado.Open
    ado.LoadFromFile PATH & fileName
    ado.Position = 0
    image = ado.Read
    ado.Close
 
    ' combine part, image , end
    ado.Open
    ado.Position = 0
    ado.Type = 1 ' binary
    ado.Write ToBytes(part)
    ado.Write image
    ado.Write ToBytes(vbCrLf & "--" & Boundary & "---")
    ado.Position = 0
    'ado.savetofile "c:\tmp\debug.bin", 2 ' overwrite
 
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.SetProperty "SelectionLanguage", "XPath"
    xmlDoc.async = False
 
    ' send request 3
    Set Requête3 = CreateObject("MSXML2.ServerXMLHTTP")
    With Requête3
        .Open "POST", URL3, False
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
        .send ado.Read
        xmlDoc.LoadXML .responseText
    End With
 
'Vérification du statut de la requête 3
    If Requête3.Status = 201 Then
    DoEvents
    Else
    MsgBox Requête3.Status & " " & Requête3.statusText, , "Statut renvoyé par le serveur - requête 3"
    End If
 
'Récupération et traitement des informations retournées par la requête 3
   Set nodeXML = xmlDoc.getElementsByTagName("Location")
For I = 0 To nodeXML.Length - 1
    URLFichier = nodeXML(I).text
Next
 
Debug.Print URLFichier
 
'Variables Requête 4
Dim Requête4 As Object
Dim URL4 As String
Dim Body4 As String
Dim Réponse4 As String
 
'Envoi de la requête 4
Set Requête4 = CreateObject("WinHttp.WinHttpRequest.5.1")
URL4 = "URLSERVEUR4"
 
    With Requête4
    .Open "POST", URL4, False
    .setRequestHeader "Authorization", "Bearer " & Token
    .setRequestHeader "Content-Type", "application/json"
    .send Range("A10").Value & URLFichier & Range("A20").Value
    End With
 
'Vérification du statut de la requête 4
    If Requête4.Status = 200 Then
    DoEvents
    Else
    MsgBox Requête4.Status & " " & Requête4.statusText, , "Statut renvoyé par le serveur - requête 4"
    End If
 
'Récupération et traitement des informations retournées par la requête 4
Debug.Print Requête4.responseText
 
Debug.Print ado.Read
 
End Sub
 
Function ToBytes(str As String) As Variant
 
    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.Read
    ado.Close
 
End Function
Merci d'avance pour vos réponses, en espérant trouver la solution !