WINHTTP Request Returns NOT FOUND and UNAUTHORIZED ACCESS (VBA EXCEL)

Greetings:

I am seeking a stable way to retrieve text files from a password protected web server. This had been working before but now it fails all my tests:banghead:. I have confirmed that I can reach the file via a browser after manually entering the .htaccess credentials. I have tried the code below with different directories and with different file names, all to no avail. Perhaps another set of eyes. AND, if any one has a better idea on how to fetch these files, PLEASE let me know. I am at the end of my rope - help would be appreciated: pray2:

Thanks in advance:

Code:

---

Public Function fetchMRTSF() As Boolean
'Check WHTTP StatusText
'* THIS SUB LOADS THE PIA ORDER MRT SOURCE FILE FROM THE SPECIFIED WEB
'* SITE TO THE SPECIFIED LOCAL CLIENT DRIVE. THE PIA ORDER MRT SOURCE
'* FILE CONTAINS ALL OF THE INFORMATION RELATIVE TO THE ASSOCIATE ORDER
'* AND IS PARSED AND STORED USING THIS UTILITY.
'* 1 SEPTEMBER 2016
'Check WHTTP StatusText
'Dim _
FileNum As Long, _
FileData() As Byte, _
WHTTP As Object, _
TempStatus As Variant, _
MainURL As String, _
FileURL As String, _
FilePath As String, _
MyUser As String, _
MyPass As String
'Set URLs and Paths
MainURL = ThisWorkbook.Sheets("CONTROL").Range("G1")
FileURL = ThisWorkbook.Sheets("CONTROL").Range("D1") & _
ThisWorkbook.Sheets("CONTROL").Range("D2")
FilePath = ThisWorkbook.Sheets("CONTROL").Range("C3") & _
ThisWorkbook.Sheets("CONTROL").Range("C2")
'END
'Set Server Credentials
MyUser = Trim(ThisWorkbook.Sheets("CONTROL").Range("C5"))
MyPass = Trim(ThisWorkbook.Sheets("CONTROL").Range("C6"))
'END
'Determine and Set WHTTP Version
On Error Resume Next
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
'END
'Post and Get WHTTP Commands and Data
'POST authentication string to the main website URL
WHTTP.Open "POST", MainURL, False
WHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'GET direct file url
WHTTP.Open "GET", FileURL, False
WHTTP.SetCredentials MyUser, MyPass, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
WHTTP.Send
' Clear last stored WHTTP.StatusText
ThisWorkbook.Sheets("CONTROL").Range("C7") = ""
' Gets Status Code
StatusResults = WHTTP.StatusText
' Store WHTTP.StatusText
ThisWorkbook.Sheets("CONTROL").Range("C7") = StatusResults
'END
'Check WHTTP StatusText
If StatusResults = "OK" Then GoTo validFile
'Path, File or Authinication Exception(Bad Request)
MsgBox _
"PIA Order MRT Source File Parser encountered the following exception." & _
vbCrLf & "WHTTP Status Code: '" & StatusResults & "'" & vbCrLf & vbCrLf & _
"Check to make certain that the URL path and MRT filename " & vbCrLf & _
"are correct. Further, verify that the Username and Password " & vbCrLf & _
"are accurate." & vbCrLf & vbCrLf & "NO MRT SOURCE FILE HAS BEEN DOWNLOADED!" _
, vbCritical, "Fetch PIA Order MRT Source File Exception"
fetchMRTSF = False
Set WHTTP = Nothing
Exit Function
'END
validFile:
'Valid File Handler and Save Data Locally
FileData = WHTTP.ResponseBody ' Gets file results
FileNum = FreeFile ' Get next available file number
Open FilePath For Binary Access Write As #FileNum
Put #FileNum, 1, FileData
Close #FileNum
fetchMRTSF = True
MsgBox _
"PIA Order MRT source file has been successfully saved.", _
vbInformation, "PIA Order MRT Source File Saved"
'END
End Function

---

Welcome to the forum! Please paste code between code tags. Click # on toolbar to insert tags.

Option Explicit as first line of Module is your friend. Set the Option to require variable declaration. I add Debug's Compile to the toolbar and compile a project before a run. Doing so, we see that we need:

Code:

---

HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0

---

Kenneth:

First sorry about not placing code inside code tags :( Please explain again how.

I did add this to a module:

Option Explicit
'HttpRequest SetCredentials flags for Function fetchMRTSF()
Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0

without the 'Const" I get an error

Oddly it seemed to work fine last night but after trying again this AM, I now just get WHTTP.StatusText "Unauthorized Access".

This is driving me crazy!

Since you did not put const in your code, I had a compile error. That is fine. Of course you can put Const inside the Sub or just as I showed is fine too. So, that is a non issue now.

Look at the concept in this code. 3 attempts are made. https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

Thanks to Kenneth Hobs, I resolved my :bug: most difficult (first) trip into the WinHttpRequest COM Object dimension:clap:

You can reduce your code to:

Code:

---

Sub M_snb()
  sn = ThisWorkbook.Sheets("CONTROL").Range("C1:G6")
 
  With CreateObject("WinHTTP.WinHTTPrequest.5.1")
      .Open "POST", sn(1, 5), False
      .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .Open "GET", sn(1, 2) & sn(2, 2), False
      .SetCredentials sn(5, 1), sn(6, 1), 0
      .Send
      Open sn(1, 3) & sn(1, 2) For Binary Access Write As #1
        Put #1, 1, .ResponseBody
      Close
    End With
End Sub

---

Kenneth:

Again, thank you. Please understand that I am an absolute novice in this area so any and all help you can offer would be greatly appreciated.

I need to add security to the code I have presented. I suspect it is using 'SetClientCertificate' ?

First, I haven't any idea about where I need to have certificates, where I get them ans so on. Then, even though I have read several pieces about this, I just can't understand which code I need to add and where to put it.

Please, if you can assist - I would be extremely grateful.

Regards

Snb:

Thanks! We have converted to using named fields for all of our value references. BUT, I am going to try your code in a different model.