使用VBA或VB6从URL(https)下载xml文件

时间:2018-09-20 13:14:05

标签: xml vba file download vb6

我想使用VBA或VB6下载此文件https://www.omniva.ee/locations.xml。 我可以使用WebClient使用C#进行此操作,但是我不知道如何在VBA或VB6中进行操作。 没有IE API,有可能吗?因为它对我不起作用:

enter image description here

Internet Explorer无法显示此页面:-(。 你能帮我吗?

2 个答案:

答案 0 :(得分:0)

一个简单的例子:

Sub Test()

    DownloadFile "https://www.omniva.ee/locations.xml", "C:\Test\locations.xml"

End Sub

Function DownloadFile(sURL As String, sPath As String)

    Dim aBody() As Byte

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sURL, False
        .Send
        aBody = .ResponseBody
    End With
    With CreateObject("ADODB.Stream")
        .Type = 1 ' adTypeBinary
        .Open
        .Write aBody
        .SaveToFile sPath, 2 ' adSaveCreateOverWrite
        .Close
    End With

End Function

答案 1 :(得分:0)

VBScript可粘贴到VBA或VB6中。您没有指定不喜欢的内容。

这使用IE

On Error Resume Next
    Set ie = CreateObject("InternetExplorer.Application") 
    msgbox ie.offline
'   ie.offline = true
    ie.Visible = 1
    ie.Silent = 1 
    ie.Navigate2 "http://www.smh.com.au"
    Do
        Msgbox ie.document.readystate()
        wscript.sleep 500           
    Loop Until ie.document.readystate = "complete"
    Msgbox ie.document.body.innertext
    ie.refresh
    ie.quit

这使用MSHTTPXML。目的是说明为什么您的URL不起作用。

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Url = "http://www.smh.com.au"

objHTTP.Open "POST", Url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/63.0.3239.132 Safari/537.36"
objHTTP.setRequestHeader "Referer", "http://finra-markets.morningstar.com/bondSearch.jsp"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
'objHTTP.send ("count=1&curPage=1&query={'Keywords':[{'Name':'debtOrAssetClass','Value':'3'},{'Name':'showResultsAs','Value':'B'}]}&searchtype=B&sortfield=issuerName&sorttype=1&start=40")
objHTTP.send 
Msgbox objHTTP.Status
Msgbox objHTTP.responseText
Msgbox objHTTP.getAllResponseHeaders

使用上面的ADODB将文件保存到磁盘。

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Outp = Wscript.Stdout
    Set wshShell = CreateObject("Wscript.Shell")
    Set ShApp = CreateObject("Shell.Application")
    On Error Resume Next
    Set File = WScript.CreateObject("Microsoft.XMLHTTP")
    File.Open "GET", "http://definitionupdates.microsoft.com/download/definitionupdates/safetyscanner/x86/msert.exe:200", False
    File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
    File.Send
'   If err.number <> 0 then 
        wscript.echo "" 
        wscript.echo "Error getting file" 
        wscript.echo "==================" 
        wscript.echo "" 
        wscript.echo "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
        wscript.echo "Source " & err.source 
        wscript.echo "" 
        wscript.echo "HTTP Error " & File.Status & " " & File.StatusText
        wscript.echo    File.getAllResponseHeaders
'   else
        On Error Goto 0
        Set BS = CreateObject("ADODB.Stream")
        BS.type = 1
        BS.open
        BS.Write File.ResponseBody
        BS.SaveToFile ShApp.Namespace(&h10).self.path & "\safetyscanner.exe", 2
        wshshell.Run "c:\users\safetyscanner.exe", 1, False
'   End If