我在stackoverflow上找到了一个链接,可能会对这个查询有所帮助: 使用VBA将图片上传到file.io(HTTP Post) 该链接提供的代码如下:
Sub UploadFilesUsingVBAORIGINAL()
'this proc will upload below files to https://file.io/
' png, jpg, txt
Dim fileFullPath As String
fileFullPath = ThisWorkbook.Path & "\Sample.txt"
POST_multipart_form_dataO fileFullPath
End Sub
Private Function GetGUID() As String
' Generate uuid version 4 using VBA
GetGUID = WorksheetFunction.Concat(WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(16384, 20479), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(32768, 49151), 4), "-", WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 65535), 4), WorksheetFunction.Dec2Hex(WorksheetFunction.RandBetween(0, 4294967295#), 8))
End Function
Private Function GetFileSize(fileFullPath As String) As Long
Dim lngFSize As Long, lngDSize As Long
Dim oFO As Object, OFS As Object
lngFSize = 0
Set OFS = CreateObject("Scripting.FileSystemObject")
If OFS.FileExists(fileFullPath) Then
Set oFO = OFS.GetFile(fileFullPath)
GetFileSize = oFO.Size
Else
GetFileSize = 0
End If
Set oFO = Nothing
Set OFS = Nothing
End Function
Private Function ReadBinary(strFilePath As String)
Dim ado As Object, bytFile
Set ado = CreateObject("ADODB.Stream")
ado.Type = 1
ado.Open
ado.LoadFromFile strFilePath
bytFile = ado.Read
ado.Close
ReadBinary = bytFile
Set ado = Nothing
End Function
Private Function toArray(str)
Dim ado As Object
Set ado = CreateObject("ADODB.Stream")
ado.Type = 2
ado.Charset = "_autodetect"
ado.Open
ado.WriteText (str)
ado.Position = 0
ado.Type = 1
toArray = ado.Read()
Set ado = Nothing
End Function
Sub POST_multipart_form_dataO(filePath As String)
Dim oFields As Object, ado As Object
Dim sBoundary As String, sPayLoad As String, GUID As String
Dim fileType As String, fileExtn As String, fileName As String
Dim sName As Variant
fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
fileExtn = Right(filePath, Len(fileName) - InStrRev(fileName, "."))
Select Case fileExtn
Case "png"
fileType = "image/png"
Case "jpg"
fileType = "image/jpeg"
Case "txt"
fileType = "text/plain"
End Select
Set oFields = CreateObject("Scripting.Dictionary")
With oFields
.Add "qquuid", LCase(GetGUID)
.Add "qqtotalfilesize", GetFileSize(filePath)
End With
sBoundary = String(27, "-") & "7e234f1f1d0654"
sPayLoad = ""
For Each sName In oFields
sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""" & sName & """" & vbCrLf & vbCrLf
sPayLoad = sPayLoad & oFields(sName) & vbCrLf
Next
sPayLoad = sPayLoad & "--" & sBoundary & vbCrLf
sPayLoad = sPayLoad & "Content-Disposition: form-data; name=""file""; " & "filename=""" & fileName & """" & vbCrLf
sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
sPayLoad = sPayLoad & "--" & sBoundary & "--"
Set ado = CreateObject("ADODB.Stream")
ado.Type = 1
ado.Open
ado.Write toArray(sPayLoad)
ado.Write ReadBinary(filePath)
ado.Position = 0
With CreateObject("MSXML2.ServerXMLHTTP")
.Open "POST", "https://file.io", False
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
.send (ado.Read())
Debug.Print .responseText
End With
End Sub
这似乎没有问题,但是当我将链接复制到浏览器中时,出现了404页面未找到的错误。
我尝试手动上传同样的文件,并没有任何问题,可以正常使用从手动步骤中获得的链接。
请求帮助,谢谢!
也发布在这里: https://chandoo.org/forum/threads/upload-file-to-file-io-using-post-method.43925/