如何使用VBA从Internet Explorer下载文件

时间:2016-08-16 19:49:33

标签: excel vba internet-explorer

我正在尝试从Internet Explorer 11下载excel工作簿,当我点击该链接时,会显示以下弹出消息:

enter image description here

我尝试使用sendkeys“%s”,但它无效。我不能使用代码从互联网上下载文件而不使用IE,因为URL是我公司的内部网站点。

Sub Site()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.application")
    With IE
        .Visible = True
        .Navigate "http://asint010/IntegradorProfit/Pages/Relatorios/FluxoSolicitacao.aspx"

        While .Busy Or .ReadyState <> 4
            DoEvents
        Wend

        .document.All("ctl00_ContentPlaceHolder1_btnexportar").Click
        While .Busy Or .ReadyState <> 4
            DoEvents
        Wend

       'here I don't know what to do

    End With
End Sub

1 个答案:

答案 0 :(得分:0)

我正在使用此代码下载该文件。您需要根据语言设置更改代码。您也可以删除一些不需要的声明功能行。

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
    Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
    Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
    Declare PtrSafe Function SetFocus Lib "user32.dll" (ByVal hWnd As Long) As Integer

    Sub Site()
        Dim IE As Object
        Set IE = CreateObject("InternetExplorer.application")
        With IE
            .Visible = True
            .Navigate "http://asint010/IntegradorProfit/Pages/Relatorios/FluxoSolicitacao.aspx"

            While .Busy Or .ReadyState <> 4
                DoEvents
            Wend

            .document.All("ctl00_ContentPlaceHolder1_btnexportar").Click
            While .Busy Or .ReadyState <> 4
                DoEvents
            Wend

           'here I don't know what to do
            hpass = IE.hWnd
            DownloadFile (hpass)

        End With
    End Sub

    Sub DownloadFile(h As Long)
        Dim o As IUIAutomation
        Dim e As IUIAutomationElement
        Dim iCnd As IUIAutomationCondition
        Dim Button As IUIAutomationElement
        Dim InvokePattern As IUIAutomationInvokePattern

        Set o = New CUIAutomation
        h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
        If h = 0 Then Exit Sub

        Set e = o.ElementFromHandle(ByVal h)
        Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
        Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
        Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke

        Application.Wait (Now + TimeValue("0:00:05"))
        Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Close")
        Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
        Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
    End Sub