Serverxmlhttp : automatisation d'envoi d'un formulaire avec upload

Commenter

Contenu du snippet

Ce script permet l'automatisation d'envoi d'un formulaire à une page de traitement web avec upload d'un (ou plusieurs) fichier(s).

Source / Exemple :

Sub Send_File()

    Dim XMLfileName As String
    Dim ZIPfileName As String
 
    'Variables systeme fichier
    Dim Fso As FileSystemObject
    Dim FSo2 As FileSystemObject
    Dim FichierLog_Stream As TextStream
    Dim LOGfileName As String
 
      
  
        
        '##########################################################################
        'Lecture du fichier pour stockage Binaire
        Dim strFileName1 As String
        Dim nFile As Integer
        Dim strText As String
        
        strFileName1 = "C:\nomfichier.xml"
        nFile = FreeFile
        
        Open strFileName1 For Binary As #nFile
        strText = String(LOF(nFile), " ")
        Get #nFile, , strText
        Close #nFile
       
        '##########################################################################
        'Préparation des entete et body du formulaire
        Dim ServerSafeHTTP As XMLHTTP50
        Set ServerSafeHTTP = CreateObject("Msxml2.ServerXMLHTTP")
                
        ServerSafeHTTP.Open "POST", Const_URL_SERVER_DEST, False
        
        Dim StrBody As String
        
        StrBody = ""
        StrBody = StrBody & setBody("Champ1", "voiture") 'Champ Champ1 du formulaire
        StrBody = StrBody & setBody("Champ2", "modele") 'Champ Champ2 du formulaire
        StrBody = StrBody & setBodyFile(Right(strFileName1, 3)) 'entete du fichier selon son type
        StrBody = StrBody & strText & vbCrLf & "--" & Const_BOUNDARY & "--" 'Fin de traitement
        
        Dim aPostData() As Byte
        aPostData = StrConv(StrBody, vbFromUnicode)
        
        ServerSafeHTTP.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Const_BOUNDARY & vbCrLf
        ServerSafeHTTP.send aPostData
        
        
        If ServerSafeHTTP.Status = 200 Then
            msgbox ("Envoi effectué :" & ServerSafeHTTP.responseText)
        Else
            msgbox ("Erreur :" & _
            ServerSafeHTTP.Status & vbcrlf & ServerSafeHTTP.statusText & vbcrlf &  ServerSafeHTTP.responseText)
        End If

End Sub

'Création des Champs du formulaire
Function setBody(name, value)
    Dim body
    body = "--" & Const_BOUNDARY & vbCrLf
    body = body & "Content-Disposition: form-data; name=""" & name & """" & vbCrLf & vbCrLf
    body = body & value & vbCrLf
    setBody = body
End Function

'Création de l'entete UPLOAD du champ fichier du formulaire selon son type
Function setBodyFile(extention)
    Dim body
    body = "--" & Const_BOUNDARY & vbCrLf
    body = body & "Content-Disposition: form-data; name=""file""; filename=""ExportCARIFPCH.xml""" & vbCrLf
    body = body & "Content-Transfer-Encoding: binary" & vbCrLf & vbCrLf
    Select Case extention
        Case "zip"
            body = body & "Content-Type: application/zip" & vbCrLf & vbCrLf
        Case "xml"
            body = body & "Content-Type: text/xml" & vbCrLf & vbCrLf
        Case Else
            body = body & "Content-Type: text/plain" & vbCrLf & vbCrLf
    End Select
    
    setBodyFile = body
End Function

Conclusion :

La procédure Setbody crée les lignes champs de formulaire
La procédure setBodyFile crée la ligne entête fichier à uploader.
Je l'ai utilisé afin d'automatiser l'envoi d'un fichier ZIP vers un servlet Java avec plusieurs champs de formulaire.
Il est possible d'envoyer le contenu d'un fichier texte ou XML sans la conversion en binaire s'il n'est pas trop grop, mais attention au timeout du serveur destinataire

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_saizonou)