通过VBA下载Excel文件

我试图通过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

尝试通过auth头发送密码。 看看是否有效。

  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