CODEWITHSUNDEEP
vbahttpshttp-headerswinhttprequest
nwhaught
nwhaught

Reputation: 1592

Invalid credentials error when attempting PUT to a HTTPS site

I am attempting to submit a file on a HTTPS site using VBA, but I am having issues with the authentication. (When viewed, the site has the standard field for file name, with a "browse" button, and a "submit" button.)

I've tried a couple of things... first, I used an InternetExplorer.Application object, but the element type that I need to populate is file, and I've read that this is not directly accessible via code for security reasons. (Sorry I don't have the link for a citation...)

Next suggestion was to use a WinHttp.WinHttpRequest.5.1 object and a PUT request. When I do that however, the response from the site is a 401, invalid authentication error.

I'm able to access the site without entering any credentials when I'm browsing normally. I've looked at some questions about HTTPS headers here and here, but haven't been able to get them to work. Can anyone see what I'm doing wrong?

Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://siteImUploadingTo.domain.com/site"
objHTTP.Open "PUT", URL, False

objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.Send ("_fileToPost=" & ThisWorkbook.Path & \filename.PDF&_pagesSelection=1-100")
Debug.Print objHTTP.ResponseText 'returns a 401 invalid credentials error.

Upvotes: 0

Views: 1207

Answers (1)

Marcos Dimitrio
Marcos Dimitrio

Reputation: 6852

Looking at your code, it appears that you're missing a .SetCredentials call, after .Open and before .Send:

objHTTP.SetCredentials username, password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER

I ran your code on my test environment, and I also had to set the WinHttpRequestOption_SslErrorIgnoreFlags option to be able to ignore all SSL errors (reference):

objHTTP.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300 //SslErrorFlag_Ignore_All

At last, I don't think your Send command will work at actually posting a file to your server. I recommend you using the code below, adapted from this blog post.

' add a reference to "Microsoft WinHTTP Services, version 5.1"
Public Function PostFile( _
    sUrl As String, sFileName As String, sUsername As String, sPassword As String, _
    Optional bIgnoreAllSslErrors As Boolean = False, Optional bAsync As Boolean _
) As String
    Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String
    Dim browser         As WinHttp.WinHttpRequest

    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile

    '--- prepare body
    sPostData = _
        "--" & STR_BOUNDARY & vbCrLf & _
            "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
            "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
            sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"

    '--- post
    Set browser = New WinHttpRequest
    browser.Open "POST", sUrl, bAsync

    browser.SetCredentials sUsername, sPassword, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER

    If bIgnoreAllSslErrors Then
        ' https://stackoverflow.com/questions/12080824/how-to-ignore-invalid-certificates-with-iwinhttprequest#12081003
        browser.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
    End If

    browser.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
    browser.Send pvToByteArray(sPostData)
    If Not bAsync Then
        PostFile = browser.ResponseText
    End If
End Function

Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

If you need to send additional fields, you can do so by modifying the sPostData variable:

sPostData = _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""field1""" & vbCrLf & vbCrLf & _
        field1 & vbCrLf & _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""field2""" & vbCrLf & vbCrLf & _
        field2 & vbCrLf & _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(FileFullPath, InStrRev(FileFullPath, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
    "--" & STR_BOUNDARY & "--"

Upvotes: 1

Related Questions