通过VBA下载Excel文件

Question

我正尝试通过Excel VBA从IBM Cognos下载文件。该脚本将执行，但我只有一个9KB的Excel文件不会打开。我如何完成这项工作？

这里是我的代码：

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

尝试通过身份验证头发送密码。看看是否有效。

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