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