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

尝试通过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

通过VBA下载Excel文件

1 个答案: