VBA（訪問）檔案上傳通過REST與MultipartFormdata-僅適用于txt檔案

對于一個專案，我需要通過（REST）Web 服務（例如 .accdb - 檔案）從 Access 上傳檔案。

上傳現在原則上也可以作業，檔案以其完整大小到達目的地。

然而，奇怪和有問題的是：我只能在目的地再次打開 .txt（簡單文本檔案，不管它有多大）檔案。所有其他檔案型別（.accdb、.png.、.jpg）都在那里，但似乎已損壞或無法打開......

我看不出我在代碼中做錯了什么！將“檔案型別”調整為相應的檔案型別也不成功。

我對 Java 也使用了相同的方法，所有檔案型別都在這里作業 -> 所以我認為我的代碼是錯誤的并且 web 服務作業......

謝謝如果有人看到我的錯誤...

這是我的代碼：

Public Sub POST_multipart_form_data(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
        Dim filesize As Long
    
    Dim authUser As String
    Dim authPass As String
    Dim url_add As String

    
        authUser = REST_ReadPropsFromFile.getJSONPROP_for_REST("username")
        authPass = REST_ReadPropsFromFile.getJSONPROP_for_REST("password")
        url_add = REST_ReadPropsFromFile.getJSONPROP_for_REST("url_add_doc")


    fileName = Right(filePath, Len(filePath) - InStrRev(filePath, "\"))
    fileExtn = Right(filePath, Len(fileName) - InStrRev(fileName, "."))


    
    fileType = "application/octet-stream"

    Set oFields = CreateObject("Scripting.Dictionary")
    With oFields
        .Add "DocumentName", fileName
        .Add "FK_Person", "xxxx"
        .Add "FK_Object", "xxxx"
        .Add "FK_FileManagerFormKey", "x"
        .Add "SystemFileType", "xxx"
        .Add "Subject", "xxxxx"
        .Add "SubjectDate", "2022-08-23"
    End With


     sBoundary = String(27, "-") & "e397af84-5525-455d-8c91-706bf0ff6b09"
          
    
    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=""DocumentContent""; " & "filename=""" & fileName & """" & vbCrLf
    sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf




    'Dim image
    'Set ado = CreateObject("ADODB.Stream")
    'ado.Type = 1 'binary
    'ado.Open
    'ado.LoadFromFile filePath
    'ado.Position = 0
    'image = ado.Read
    'ado.Close
        
    ' combine part, image , end
    Set ado2 = CreateObject("ADODB.Stream")
    ado2.Open
    ado2.Position = 0
    ado2.Type = 1 ' binary
    ado2.Write ToBytes(sPayLoad)
    'ado2.Write image
    ado2.Write ReadBinary(filePath)
    ado2.Write ToBytes(vbCrLf & "--" & sBoundary & "--" & vbCrLf)
    ado2.Position = 0


    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "POST", url_add, False
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
        .SetRequestHeader "api-version", "v1"
        .SetRequestHeader "Authorization", "Basic "   _
            Base64Encode(authUser   ":"   authPass)
        .Send (ado2.Read())
        
        Debug.Print .ResponseText
        MsgBox .ResponseText

    End With



End Sub






Function ToBytes(str As String) As Variant

    Dim ado As Object
    Set ado = CreateObject("ADODB.Stream")
    ado.Open
    ado.Type = 2 ' text
    ado.Charset = "_autodetect"
    ado.WriteText str
    ado.Position = 0
    ado.Type = 1
    ToBytes = ado.Read
    ado.Close

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

uj5u.com熱心網友回復：

我發現了錯誤：

錯誤的：

sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf

正確的：

sPayLoad = sPayLoad & "Content-Type: " & fileType & vbCrLf & vbCrLf

標籤：vba 毫秒访问 http-post

上一篇：表單按鈕不會運行OpenRecordSetVBA

下一篇：將附件匯出到檔案夾