Invalid credentials error when attempting PUT to a HTTPS site - vba

Question

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.

Answer 1

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 & "--"