Download Excel File via VBA - vba

Question

I am trying to download a file from IBM Cognos via Excel VBA. The script will execute, but I only get a 9KB Excel file that will not open. How do I make this work?
Here is my code:
Sub ado_stream()
'add a reference to Microsoft XML v6 and MS ActiveX Data Objects
'via Tools/References
'This assumes the workbook is saved already, and that you want the file in the same folder
Dim fileStream As ADODB.Stream
Dim xmlHTTP As MSXML2.xmlHTTP
Dim strURL As String
strURL = "http://foo.bar"
Set xmlHTTP = New MSXML2.xmlHTTP
xmlHTTP.Open "GET", strURL, False, "username", "password"
xmlHTTP.Send
If xmlHTTP.status <> 200 Then
MsgBox "File not found"
GoTo exitsub
End If
Set fileStream = New ADODB.Stream
With fileStream
.Open
.Type = adTypeBinary
.Write xmlHTTP.responseBody
.Position = 0
.SaveToFile "C:\Users\myname\Downloads\Test.xlsx"
.Close
End With
exitsub:
Set fileStream = Nothing
Set xmlHTTP = Nothing
End Sub

Answer 1

try sending the password via auth header. see if that works.
Set xmlHTTP = New MSXML2.xmlHTTP
xmlHTTP.Open "GET", strURL, False
xmlHTTP.setRequestHeader "Authorization", "Basic " & EncodeBase64
xmlHTTP.Send
'EncodeBase Function. Put your actual user name and password here.
Private Function EncodeBase64() As String
Dim arrData() As Byte
arrData = StrConv("<<username>>" & ":" & "<<password>>", vbFromUnicode)
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function