通过VBA上传图片响应“文件不能为空”

ludexin · 发表于 2023-7-19 13:00

本帖最后由 ludexin 于 2023-7-22 01:06 编辑

需要将本地的文本上传到网站，但提交后响应的结果是{"success":0,"code":"","msg":"文件不能为空"}，请帮忙看下是哪里有问题，谢谢！

Option Explicit
Dim username As String, password As String, orgCode As String, orgName As String, Distributor As String, Boundary As String, token As String
Sub 图片上传()
Dim http As Object, url As String, filePath As String, base64Data As String, requestBody As String
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'请求网址
url = "https://example.com"
' 图片转换Base64
filePath = "D:\1.jpg"
base64Data = JpgToBase64(filePath)
' 创建请求体（body）
Boundary = "----WebKitFormBoundaryvBoSGERTQfZs7f8d"
requestBody = "--" & Boundary & vbCrLf
requestBody = requestBody & "Content-Disposition: form-data; name=""imageFile""; filename=""" & FilePathToFileName(filePath) & """" & vbCrLf
requestBody = requestBody & "Content-Type: image/jpeg" & vbCrLf & vbCrLf
requestBody = requestBody & base64Data & vbCrLf
requestBody = requestBody & "--" & Boundary & "--" & vbCrLf
' 发送POST请求
Distributor = ""
token = ""
http.Open "POST", url, False
http.setRequestHeader "Distributor", Distributor 'Distributor必填
http.setRequestHeader "Authorization", "Bearer " & token 'Authorization必填
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary 'Content-Typen必填
http.Send requestBody
Debug.Print http.responsetext
' 检查HTTP响应的状态码
If http.Status = 200 Then
MsgBox "上传成功!"
Else
MsgBox "上传失败: " & http.Status & " - " & http.responsetext
End If
' 清理对象
Set http = Nothing
End Sub
Function FilePathToFileName(filePath As String) As String
Dim fileName As String
fileName = Mid(filePath, InStrRev(filePath, "") + 1)
FilePathToFileName = fileName
End Function
Function JpgToBase64(filePath As String) As String
Dim imageFile As Object
Set imageFile = CreateObject("ADODB.Stream")
With imageFile
.Type = 1 '二进制模式
.Open
.LoadFromFile filePath
Dim byteArray() As Byte
byteArray = .Read
JpgToBase64 = EncodeBase64(byteArray)
.Close
End With
Set imageFile = Nothing
End Function
Function EncodeBase64(ByRef inData() As Byte) As String
Dim xmlObj As Object
Set xmlObj = CreateObject("MSXML2.DOMDocument")
Dim elemNode As Object
Set elemNode = xmlObj.createElement("tmp")
With elemNode
.DataType = "bin.base64"
.nodeTypedValue = inData
EncodeBase64 = Replace(.text, vbLf, "")
End With
Set elemNode = Nothing
Set xmlObj = Nothing
End Function

复制代码

perfect131 · 发表于 2023-7-19 19:45

长传的不是图片的 Base64，而是二进制内容

看看这个
https://club.excelhome.net/threa ... tml?_dsign=35e4d643
有偿可以找我

ludexin · 发表于 2023-7-19 22:12

我把上传文件修改为二进制流，提交报403.

Option Explicit
Dim username As String, password As String, orgCode As String, orgName As String, Distributor As String, Boundary As String, token As String
Sub 图片上传()
Dim http As Object, url As String, filePath As String, base64Data As String, requestBody As String
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
'请求网址
url = "https://example.com"
' 图片转换Base64
filePath = "D:\1.jpg"
fileData = FileToByte(filePath)
' 创建请求体（body）
Boundary = "----WebKitFormBoundaryvBoSGERTQfZs7f8d"
requestBody = "--" & Boundary & vbCrLf
requestBody = requestBody & "Content-Disposition: form-data; name=""imageFile""; filename=""" & FilePathToFileName(filePath) & """" & vbCrLf
requestBody = requestBody & "Content-Type: image/jpeg" & vbCrLf & vbCrLf
requestBody = requestBody & fileData & vbCrLf
requestBody = requestBody & "--" & Boundary & "--" & vbCrLf
' 发送POST请求
Distributor = ""
token = ""
http.Open "POST", url, False
http.setRequestHeader "Distributor", Distributor 'Distributor必填
http.setRequestHeader "Authorization", "Bearer " & token 'Authorization必填
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary 'Content-Typen必填
http.Send requestBody
Debug.Print http.responsetext
' 检查HTTP响应的状态码
If http.Status = 200 Then
MsgBox "上传成功!"
Else
MsgBox "上传失败: " & http.Status & " - " & http.responsetext
End If
' 清理对象
Set http = Nothing
End Sub
Function FilePathToFileName(filePath As String) As String
Dim fileName As String
fileName = Mid(filePath, InStrRev(filePath, "") + 1)
FilePathToFileName = fileName
End Function
Function FileToByte(strFileName As String)
'文件转流
With CreateObject("Adodb.Stream")
.Open
.Type = 1 'adTypeBinary
.LoadFromFile strFileName
FileToByte = .Read
.Close
End With
End Function

复制代码

ludexin · 发表于 2023-7-19 22:14

本帖最后由 ludexin 于 2023-7-22 01:05 编辑

--------------

		自动登录	找回密码
密码			免费注册

[求助] 通过VBA上传图片响应“文件不能为空”