VBA UI Automation - Internet Explorer "Save As"

Question

I'm using MS Access, and Internet Explorer 10

I'm attempting to automate the download of a series of documents on a daily basis. The file types can differ. Using the code below, I've managed to save the documents to a temporary folder, however I would ultimately like to 'Save As' and save the documents in a pre-determined folder with a specific name based on the file being downloaded.

Private 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

Dim IE As InternetExplorer
Dim h As LongPtr
    'Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

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

On Error GoTo errorh

Set o = New CUIAutomation
h = IE.hwnd
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 Button = e.FindFirst(TreeScope_Subtree, iCnd)
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

exitsub:
Exit Sub

errorh:
MsgBox Err.Number & "; " & Err.Description
Resume exitsub

End Sub

I've tried substituting 'Save' with 'Save As', 'SaveAs', etc when creating the IUIAutomationCondition UIA_NamePropertyID, and have tried different iterations of the TreeScope enumeration along with the .FindFirst and .FindAll methods of the IUIAutomationElement (FindAll results in type mismatch error).

My question is: Can this be achieved via the FindAll method of Treewalker? If either, how does one go about doing this? How does one go about finding the 'names' of UI Elements? And if the element is a child element, how does one reference it?

An alternate (and sub-par) solution for excel documents is to initiate the 'Open' of a document and save the active workbook, but the file types can differ, so this solution will only work for a specific file type.

Any help is appreciated.

Did you consider using the UrlDownloadToFile API? See: http://stackoverflow.com/questions/26186279/urldownloadtofile-in-access-2010-sub-or-function-not-defined — Ryan Wildry, Feb 07 '17 at 17:13
@RyanWildry That's a good suggestion. I suppose the challenge to overcome there is determining the name of the file that is being downloaded. — RyanL, Feb 07 '17 at 17:36

score 2 · Accepted Answer · edited May 23 '17 at 12:09

For lack of a better answer, I'm posting my solution here. The 'Save As' functionality appears to be inaccessible without using SendKeys...which of course is less than optimal given that a user can easily defeat the purpose by actively working on their desktop while the process is running. Regardless, this process is initiated by calling the Download() procedure, passing the browser, the filename, and whether or not they'd care to replace the file if it exists already. If no filename is passed the default 'Save' functionality is called and the default file name will save in the default folder. This data has been accumulated and adapted from various sources both here at StackOverflow and elsewhere and should be a somewhat effective solution in MS Access.

Option Explicit

Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Declare PtrSafe Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)

Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr


Declare PtrSafe Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As LongPtr) As Long

Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long



Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long



Public Const BM_CLICK = &HF5
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE

Public Sub Download(ByRef oBrowser As InternetExplorer, _
                     ByRef sFilename As String, _
                     ByRef bReplace As Boolean)

    If sFilename = "" Then
        Call Save(oBrowser)
    Else
        Call SaveAs(oBrowser, sFilename, bReplace)
    End If

End Sub

'https://stackoverflow.com/questions/26038165/automate-saveas-dialouge-for-ie9-vba
Public Sub Save(ByRef oBrowser As InternetExplorer)

    Dim AutomationObj As IUIAutomation
    Dim WindowElement As IUIAutomationElement
    Dim Button As IUIAutomationElement
    Dim hWnd As LongPtr

    Set AutomationObj = New CUIAutomation

    hWnd = oBrowser.hWnd
    hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
    If hWnd = 0 Then Exit Sub

    Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)
    Dim iCnd As IUIAutomationCondition
    Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Save")

    Set Button = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

End Sub

Sub SaveAs(ByRef oBrowser As InternetExplorer, _
                     sFilename As String, _
                     bReplace As Boolean)

    'https://msdn.microsoft.com/en-us/library/system.windows.automation.condition.truecondition(v=vs.110).aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1
    Dim AllElements As IUIAutomationElementArray
    Dim Element As IUIAutomationElement
    Dim InvokePattern As IUIAutomationInvokePattern
    Dim iCnd As IUIAutomationCondition
    Dim AutomationObj As IUIAutomation
    Dim FrameElement As IUIAutomationElement
    Dim bFileExists As Boolean
    Dim hWnd As LongPtr

    'create the automation object
    Set AutomationObj = New CUIAutomation

    WaitSeconds 3

    'get handle from the browser
    hWnd = oBrowser.hWnd

    'get the handle to the Frame Notification Bar
    hWnd = FindWindowEx(hWnd, 0, "Frame Notification Bar", vbNullString)
    If hWnd = 0 Then Exit Sub

    'obtain the element from the handle
    Set FrameElement = AutomationObj.ElementFromHandle(ByVal hWnd)

    'Get split buttons elements
    Set iCnd = AutomationObj.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_SplitButtonControlTypeId)
    Set AllElements = FrameElement.FindAll(TreeScope_Subtree, iCnd)

    'There should be only 2 split buttons only
    If AllElements.length = 2 Then

        'Get the second split button which when clicked shows the other three Save, Save As, Save and Open
        Set Element = AllElements.GetElement(1)

        'click the second spin button to display Save, Save as, Save and open options
        Set InvokePattern = Element.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke

        'Tab across from default Open to Save, down twice to click Save as
        'Displays Save as window
        SendKeys "{TAB}"
        SendKeys "{DOWN}"
        SendKeys "{ENTER}"

        'Enter Data into the save as window


        Call SaveAsFilename(sFilename)

        bFileExists = SaveAsSave
        If bFileExists Then
            Call File_Already_Exists(bReplace)
        End If
    End If
End Sub

Private Sub SaveAsFilename(filename As String)

    Dim hWnd As LongPtr
    Dim Timeout As Date
    Dim fullfilename As String
    Dim AutomationObj As IUIAutomation
    Dim WindowElement As IUIAutomationElement


    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
    Timeout = Now + TimeValue("00:00:10")
    Do
        hWnd = FindWindow("#32770", "Save As")
        DoEvents
        Sleep 200
    Loop Until hWnd Or Now > Timeout

    If hWnd Then

        SetForegroundWindow hWnd

        'create the automation object
        Set AutomationObj = New CUIAutomation

        'obtain the element from the handle
        Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWnd)

        'Set the filename into the filename control only when one is provided, else use the default filename
        If filename <> "" Then Call SaveAsSetFilename(filename, AutomationObj, WindowElement)

    End If

End Sub

'Set the filename to the Save As Dialog
Private Sub SaveAsSetFilename(ByRef sFilename As String, ByRef AutomationObj As IUIAutomation, _
                                ByRef WindowElement As IUIAutomationElement)

    Dim Element As IUIAutomationElement
    Dim ElementArray As IUIAutomationElementArray
    Dim iCnd As IUIAutomationCondition

    'Set the filename control
    Set iCnd = AutomationObj.CreatePropertyCondition(UIA_AutomationIdPropertyId, "FileNameControlHost")
    Set ElementArray = WindowElement.FindAll(TreeScope_Subtree, iCnd)

    If ElementArray.length <> 0 Then
        Set Element = ElementArray.GetElement(0)
        'should check that it is enabled

        'Update the element
        Element.SetFocus

        ' Delete existing content in the control and insert new content.
        SendKeys "^{HOME}" ' Move to start of control
        SendKeys "^+{END}" ' Select everything
        SendKeys "{DEL}" ' Delete selection
        SendKeys sFilename
    End If

End Sub



'Get the window text
Private Function Get_Window_Text(hWnd As LongPtr) As String

    'Returns the text in the specified window

    Dim Buffer As String
    Dim length As Long
    Dim result As Long

    SetForegroundWindow hWnd
    length = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
    Buffer = Space(length + 1) '+1 for the null terminator
    result = SendMessage(hWnd, WM_GETTEXT, Len(Buffer), ByVal Buffer)


    Get_Window_Text = Left(Buffer, length)

End Function

'Click Save on the Save As Dialog
Private Function SaveAsSave() As Boolean

    'Click the Save button in the Save As dialogue, returning True if the ' already exists'
    'window appears, otherwise False

    Dim hWndButton As LongPtr
    Dim hWndSaveAs As LongPtr
    Dim hWndConfirmSaveAs As LongPtr
    Dim Timeout As Date


    'Find the Save As window, waiting a maximum of 10 seconds for it to appear
    Timeout = Now + TimeValue("00:00:10")
    Do
        hWndSaveAs = FindWindow("#32770", "Save As")
        DoEvents
        Sleep 200
    Loop Until hWndSaveAs Or Now > Timeout

    If hWndSaveAs Then

        SetForegroundWindow hWndSaveAs

        'Get the child Save button
        hWndButton = FindWindowEx(hWndSaveAs, 0, "Button", "&Save")
    End If

    If hWndButton Then

        'Click the Save button


        Sleep 100
        SetForegroundWindow hWndButton
        PostMessage hWndButton, BM_CLICK, 0, 0
    End If


    'Set function return value depending on whether or not the ' already exists' popup window exists
    Sleep 500
    hWndConfirmSaveAs = FindWindow("#32770", "Confirm Save As")

    If hWndConfirmSaveAs Then
        SaveAsSave = True
    Else
        SaveAsSave = False
    End If

End Function

'Addresses the case when saving the file when it already exists.
'The file can be overwritten if Replace boolean is set to True
Private Sub File_Already_Exists(Replace As Boolean)

    'Click Yes or No in the ' already exists. Do you want to replace it?' window

    Dim hWndSaveAs As LongPtr
    Dim hWndConfirmSaveAs As LongPtr
    Dim AutomationObj As IUIAutomation
    Dim WindowElement As IUIAutomationElement
    Dim Element As IUIAutomationElement
    Dim iCnd As IUIAutomationCondition
    Dim InvokePattern As IUIAutomationInvokePattern


    hWndConfirmSaveAs = FindWindow("#32770", "Confirm Save As")

    Set AutomationObj = New CUIAutomation
    Set WindowElement = AutomationObj.ElementFromHandle(ByVal hWndConfirmSaveAs)

    If hWndConfirmSaveAs Then

        If Replace Then
            Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "Yes")
        Else
            Set iCnd = AutomationObj.CreatePropertyCondition(UIA_NamePropertyId, "No")
        End If

        Set Element = WindowElement.FindFirst(TreeScope_Subtree, iCnd)
        Set InvokePattern = Element.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
    End If

End Sub


Public Sub WaitSeconds(intSeconds As Integer)
  On Error GoTo Errorh

  Dim datTime As Date

  datTime = DateAdd("s", intSeconds, Now)

  Do
    Sleep 100
    DoEvents
  Loop Until Now >= datTime

exitsub:
  Exit Sub

Errorh:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "WaitSeconds"
  Resume exitsub
End Sub

References: SaveasDialog

True Condition

Faidootdoot

score 0 · Answer 2 · answered Oct 08 '19 at 05:45

Well, I reached this question by googling for FileNameControlHost keyword because save file dialog automation stopped to work in Windows 10 (it worked in Windows 7). And automation code with SendKeys would not work for paths with non-ASCII symbols.

The code would look like:

    public void SetSaveDialogFilePath(string filePath)
    {
        if (File.Exists(filePath))
        {
            File.Delete(filePath);
        }

        var fileNameElement = app.FindFirst(TreeScope.Subtree, new AndCondition(
                                                             new PropertyCondition(AutomationElement.ClassNameProperty, "AppControlHost"),
                                                             new PropertyCondition(AutomationElement.AutomationIdProperty, "FileNameControlHost")));

        var valuePattern = (ValuePattern)fileNameElement.GetCurrentPattern(ValuePattern.Pattern);
        fileNameElement.SetFocus();
        valuePattern.SetValue(filePath);
        Thread.Sleep(100);
        // Even if text value is set we have to select it from drop down as well otherwise it is not applied
        var expandPattern = (ExpandCollapsePattern)fileNameElement.GetCurrentPattern(ExpandCollapsePattern.Pattern);
        if (expandPattern != null)
        {
            expandPattern.Expand();
            AutomationElement item = null;
            while (item == null)
            {
                Thread.Sleep(10);
                item = fileNameElement.FindFirst(TreeScope.Subtree, new PropertyCondition(AutomationElement.NameProperty, filePath));
            }
            ((SelectionItemPattern)item.GetCurrentPattern(SelectionItemPattern.Pattern)).Select();
            expandPattern.Collapse();
        }
        var button = app.FindFirst(TreeScope.Subtree, new AndCondition(
                                                             new PropertyCondition(AutomationElement.ClassNameProperty, "Button"),
                                                             new PropertyCondition(AutomationElement.AutomationIdProperty, "1")));
        ((TogglePattern)button.GetCurrentPattern(TogglePattern.Pattern)).Toggle();
    }

score 0 · Answer 3 · answered Feb 03 '20 at 05:40

This is working for me. Add this to top of your function

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

after your code Add

Dim o As IUIAutomation Dim e As IUIAutomationElement

Set o = New CUIAutomation
Dim h As Long
h = IE.hWnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub

Set e = o.ElementFromHandle(ByVal h)
Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")

Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

References need : UIautomationclient microsoft DAo3.6 object library UIautomationclientpriv microsoft html object library microsoft internet controls

VBA UI Automation - Internet Explorer "Save As"

3 Answers3