VBA - Upload de fichier automatique
Bonjour,
Je cherche en VBA à accéder à une page web pour upload une image automatiquement.
Après une journée de recherche, j'ai fini par comprendre que le problème venait de l'input "type = file" dans le formulaire.. :roll:
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
| '******************* upload - begin
'Upload file using input type=file
Sub UploadFile(DestURL As String, FileName As String, _
Optional ByVal FieldName As String = "File")
Dim sFormData As String, d As String
'Boundary of fields.
'Be sure this string is Not In the source file
Const Boundary As String = "---------------------------0123456789012"
'Get source file As a string.
sFormData = GetFile(FileName)
'Build source form with file contents
d = "--" + Boundary + vbCrLf
d = d + "Content-Disposition: form-data; name=""" + FieldName + """;"
d = d + " filename=""" + FileName + """" + vbCrLf
d = d + "Content-Type: application/upload" + vbCrLf + vbCrLf
d = d + sFormData
d = d + vbCrLf + "--" + Boundary + "--" + vbCrLf
'Post the data To the destination URL
Call IEPostStringRequest(DestURL, d, Boundary)
End Sub
'sends URL encoded form data To the URL using IE
Sub IEPostStringRequest(URL As String, FormData As String, Boundary As String)
'Create InternetExplorer
Dim WebBrowser: Set WebBrowser = CreateObject("InternetExplorer.Application")
'You can uncoment Next line To see form results
WebBrowser.Visible = True
'Send the form data To URL As POST request
Dim bFormData() As Byte
ReDim bFormData(Len(FormData) - 1)
bFormData = StrConv(FormData, vbFromUnicode)
WebBrowser.Navigate URL, , , bFormData, _
"Content-Type: multipart/form-data; boundary=" + Boundary + vbCrLf
Do While WebBrowser.busy
DoEvents
Loop
'WebBrowser.Quit (Mise en commentaire de ma part)
End Sub
'read binary file As a string value
Function GetFile(FileName As String) As String
Dim FileContents() As Byte, FileNumber As Integer
ReDim FileContents(FileLen(FileName) - 1)
FileNumber = FreeFile
Open FileName For Binary As FileNumber
Get FileNumber, , FileContents
Close FileNumber
GetFile = StrConv(FileContents, vbUnicode)
End Function
'******************* upload - end |
Que j'appelle ainsi:
Code:
1
2
3
4
5
6
7
| Sub TestUpload()
Dim PicLoc As String
PicLoc = "C:\test.png"
UploadFile "http://www.hapshack.com", _
"C:\test.png", "fileup"
End Sub |
...Mais ça ne marche pas, et le code me dépasse un peu pour être honnête.
Un peu d'aide pour comprendre et m'aider a le faire fonctionner sont les bienvenue, ou une alternative :P
Merci d'avance.
Je me permet de faire un double post pour remettre la question en évidence dans la mesure ou la demande a totalement changée mais que le problème de base est le même: l'upload d'une image de façon automatisée.
