Upload d'un PDF sur un serveur grâce à une API

Bonjour à tous,

Je suis nouveau sur ce forum et je bloque sur un développement depuis quelques temps et je n'arrive pas à trouver de solution. La situation est la suivante : Je souhaite uploader un fichier PDF sur un serveur depuis Excel grâce à une API. Il se trouve que malgré de nombreuses recherches sur le sujet je reste toujours bloqué. J'arrive à uploader le fichier sur le serveur sans soucis, en revanche ce fichier est illisible.

Voici le code que j'utilise actuellement :

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 !

Bonjour Lucas et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum.

Sinon par rapport à votre question, ce code me parait bien compliqué pour simplement uploadé un fichier PDF

Je pense donc qu'on ne sait pas tout... C'est un serveur d'entreprise ou un site web ?

A+

Bonjour Bruno,

Tout d'abord merci pour votre accueil et votre réponse rapide !

J'ai effectué ma petite présentation, et ai bien lu la charte du forum

Pour ce qui est de ma problématique j'ai effectivement été un peu court :

Je m'explique : Le serveur sur lequel je souhaite uploader le fichier est un serveur d'entreprise.

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 ai 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.

J'espère avoir été plus clair,
Merci d'avance !

Re,

Je pense que le souci viens de là

    ' 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

Peut-être ajouter après Open

ado.Charset = "utf-8"

Mais n'étant pas un expert de l'ADODB.Stream

A+

Re,

Merci pour ton aide,

J'ai essayé de rajouter ado.Charset = "utf-8" après Open et cela me sort l'erreur d'exécution '3219' : "L'opération demandée n'est pas autorisée dans ce contexte".

Je continue de chercher de mon côté, si quelqu'un a une autre idée je suis preneur...

Re,

N'ayant toujours pas trouvé la réponse, j'ai clôturé le sujet et ai posté sur un autre forum.

Bonne journée ! :)