Press Save Button IE Download Prompt via Custom Functions

Question

I have managed to erase all sendkeys from my sub to pull a spreadsheet from IE except for hitting the "save" button on the download prompt at the end. I know there are many posts about this, and I have read them all, but today I found what looks like a great function, but I can't seem to adapt it/get it to work.

Note: This is not a URL I can call w/ Params, but I enter information on the page and hit button Excel which then spits back a download prompt for a spreadsheet.

I'm also not sure if the below code is meant to run on the "Download" full window (CTRL + J) or the prompt bar down at the bottom, but I tried both without luck. I can open the "full window" if needed, but it would require sendkeys which I'm looking to eliminate, but currently the code naturally just displays the download "bar" at the bottom of the window.

Here is some links:

Excel VBA to Save As from IE 11 Download Bar

https://www.mrexcel.com/board/threads/need-help-regarding-ie-automation-using-vba.502298/page-2

Here is my code so far w/ two variations using each link:

Functions (separate module)

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Private Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare Function CloseClipboard Lib "user32" () As Long
      Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Private Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If
Public IEObj As Object
Public Sub Activate_A_Window(WindowName As String)
    Dim IE As Object
    Dim Windows As Object: Set Windows = CreateObject("Shell.Application").Windows
    Dim Window As Object
    Dim my_title As String

    For Each Window In Windows
        my_title = Window.LocationName
        Debug.Print "Window Title = " & my_title
        If InStr(1, my_title, WindowName) Then
            Set IE = Window
            Exit For
        End If
    Next Window

    If Not IE Is Nothing Then 'Make sure IE was found as a window
        If CBool(IsIconic(IE.hWnd)) Then ' If it's minimized, show it
            ShowWindow IE.hWnd, SW_RESTORE
        End If

        SetForegroundWindow IE.hWnd 'Set the window as the foreground
    Else
        Debug.Print (WindowName & " could not be located")
    End If

End Sub
Public Sub OpenIEURL(URL As String, Optional SecondURL As String)
 Application.Wait (Now() + TimeValue("00:00:01"))
 Set IEObj = CreateObject("InternetExplorer.Application")
    
 IEObj.navigate URL
 Do Until IEObj.readyState = 4
  DoEvents
 Loop
 IEObj.TheaterMode = True
 IEObj.Visible = True
 
 If SecondURL <> "" Then
  IEObj.navigate SecondURL
 End If
 
 'Bring IEObj to Focus
 HWNDSrc = IEObj.hWnd
 SetForegroundWindow HWNDSrc
 IEObj.Visible = False
 IEObj.Visible = True
 Call Activate_A_Window(URL)
End Sub
Public Sub CloseIEObj()
 'Unload IE
 IEObj.TheaterMode = False
 Application.Wait (Now() + TimeValue("00:00:04"))
 IEObj.Quit
 Set IEObj = Nothing
 Application.Wait (Now() + TimeValue("00:00:01"))
End Sub

Module:

Option Explicit
Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Const BM_CLICK = &HF5
Public Const WM_SETTEXT = &HC
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

Private Sub File_Download_Click_Save()
    
    Dim hWnd As Long
    Dim timeout As Date
    
    Debug.Print "File_Download_Click_Save"
    
    'Find the File Download window, waiting a maximum of 30 seconds for it to appear
    
    timeout = Now + TimeValue("00:00:30")
    Do
        hWnd = FindWindow("#32770", "File Download")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > timeout
    
    Debug.Print "   File Download window "; Hex(hWnd)
    
    If hWnd Then
        'Find the child Save button
        
        hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
        Debug.Print "   Save button "; Hex(hWnd)
    End If
    
    If hWnd Then
    
        'Click the Save button
        
        SetForegroundWindow (hWnd)
        Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
        SendMessage hWnd, BM_CLICK, 0, 0
    End If
End Sub

Public Sub WVinput()
 Dim URL As String
 URL = "http://url.com"
 Call OpenIEURL(URL)
 
    IEObj.document.getElementById("buttonExcel").Click ' Hit Excel Button
    Application.Wait (Now() + TimeValue("00:00:10"))

    Call File_Download_Click_Save ' This didn't work

'wait for save as window to appear
Dim o As IUIAutomation
Dim h As LongPtr
Set o = New CUIAutomation
h = 0
Do Until h > 0
    'h = ie.hWnd
    h = FindWindow("#32770", "Internet Explorer")
Loop

'find and click save as button
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Dim Button As IUIAutomationElement
Set e = o.ElementFromHandle(ByVal h)
Set Button = Nothing
Do Until Not Button Is Nothing
    'Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save as")
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save") ' Note I'm trying to hit "Save" not "Save As"
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Loop

Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

    'SendKeys old method
    'SendKeys "%s", True ' Select "Save" in DL Window
    'Application.Wait (Now() + TimeValue("00:00:02"))
    'SendKeys "%s", True ' Select "Save" in DL Window
    Application.Wait (Now() + TimeValue("00:00:02"))
    
 Call CloseIEObj
 
End Sub

FreeSoftwareServers · Accepted Answer · 2021-02-19T19:24:20.330

Got it! No SendKeys at all in my sub now, but I did have to show the IE Object for a brief moment to find the "Save button". Reliability has multiplied 10 fold!

Funcs:

#If VBA7 Then
'Code is running VBA7 (2010 or later).

     #If Win64 Then
     'Code is running in 64-bit version of Microsoft Office.
      Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
      Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare PtrSafe Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #Else
     'Code is running in 32-bit version of Microsoft Office.
      Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function CloseClipboard Lib "user32" () As Long
      Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
      Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
      Public Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
     #End If

#Else
'Code is running VBA6 (2007 or earlier).

#End If

Public IEObj As Object, HWNDSrc As LongPtr

Public Sub Activate_A_Window(WindowName As String)
    Dim IE As Object
    Dim Windows As Object: Set Windows = CreateObject("Shell.Application").Windows
    Dim Window As Object
    Dim my_title As String

    For Each Window In Windows
        my_title = Window.LocationName
        Debug.Print "Window Title = " & my_title
        If InStr(1, my_title, WindowName) Then
            Set IE = Window
            Exit For
        End If
    Next Window

    If Not IE Is Nothing Then 'Make sure IE was found as a window
        If CBool(IsIconic(IE.hWnd)) Then ' If it's minimized, show it
            ShowWindow IE.hWnd, SW_RESTORE
        End If

        SetForegroundWindow IE.hWnd 'Set the window as the foreground
    Else
        Debug.Print (WindowName & " could not be located")
    End If

End Sub

Public Sub OpenIEURL(URL As String, Optional ShowIEWindow As Boolean, Optional SecondURL As String)
 Application.Wait (Now() + TimeValue("00:00:01"))
 Set IEObj = CreateObject("InternetExplorer.Application")
    
 IEObj.navigate URL
 Do Until IEObj.readyState = 4
  DoEvents
 Loop
 If ShowIEWindow = True Then
  IEObj.TheaterMode = True
  IEObj.Visible = True
 End If
 
 If SecondURL <> "" Then
  IEObj.navigate SecondURL
 End If
 
 'Bring IEObj to Focus
 HWNDSrc = IEObj.hWnd
 'Debug.Print HWNDSrc
 
 If ShowIEWindow = True Then
  SetForegroundWindow HWNDSrc
  IEObj.Visible = False
  IEObj.Visible = True
  Call Activate_A_Window(URL)
 End If
End Sub

Public Sub File_Download_Click_Save(HWNDSrc As LongPtr)
'find and click save as button
 Dim o As IUIAutomation
 Dim h As LongPtr
 Set o = New CUIAutomation
 h = HWNDSrc
 IEObj.Visible = True
 Dim e As IUIAutomationElement
 Dim iCnd As IUIAutomationCondition
 Dim Button As IUIAutomationElement
 Set e = o.ElementFromHandle(ByVal h)
 Set Button = Nothing
 Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")
 Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
 Dim InvokePattern As IUIAutomationInvokePattern
 Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
 InvokePattern.Invoke
 IEObj.Visible = False
End Sub

Public Sub CloseIEObj()
 'Unload IE
 IEObj.TheaterMode = False
 Application.Wait (Now() + TimeValue("00:00:04"))
 IEObj.Quit
 Set IEObj = Nothing
 Application.Wait (Now() + TimeValue("00:00:01"))
End Sub

Module:

Public Sub WVinput()
 Dim URL As String
 URL = "http://url.com"
 Call OpenIEURL(URL)   

    IEObj.document.getElementById("buttonExcel").Click ' Hit Excel Button
    Application.Wait (Now() + TimeValue("00:00:10"))
    
    HWNDSrc = IEObj.hWnd
    Call File_Download_Click_Save(HWNDSrc)

    Application.Wait (Now() + TimeValue("00:00:02"))
    
 Call CloseIEObj
 
End Sub

Note: This requires UIAutomationClient reference Library.

@YuZhou im well aware of the workings of SO... those comments are generally better suited to new users. Thank you tho. — FreeSoftwareServers, Feb 19 '21 at 06:47

Press Save Button IE Download Prompt via Custom Functions

1 Answers1