VBA UI Automation - Internet Explorer "Save As" - vba

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.

Answer 1

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

Answer 2

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();
}

Answer 3

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