通過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