簡體   English   中英

如何使用 VBA 從 Internet Explorer 下載文件

[英]How to download a file from internet explorer using VBA

我正在嘗試從 Internet Explorer 11 下載 Excel 工作簿,當我單擊該鏈接時,會出現以下彈出消息:

在此處輸入圖片說明

我試過使用 sendkeys "%s" 但它沒有用。 如果不使用 IE,我無法使用代碼從 Internet 下載文件,因為 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

我正在使用此代碼下載文件。 您需要根據您的語言設置更改代碼。 您也可以刪除一些不需要的聲明功能行。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM