VBA UI 自动化 - Internet Explorer“另存为”

VBA UI Automation - Internet Explorer "Save As"

提问by RyanL

I'm using MS Access, and Internet Explorer 10

我使用的是 MS Access 和 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).

在创建 IUIAutomationCondition UIA_NamePropertyID 时，我尝试将“保存”替换为“另存为”、“另存为”等，并尝试了 TreeScope 枚举的不同迭代以及 IUIAutomationElement 的 .FindFirst 和 .FindAll 方法（FindAll 结果为类型不匹配错误）。

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?

我的问题是：这可以通过 Treewalker 的 FindAll 方法实现吗？如果有的话，怎么做呢？如何找到 UI 元素的“名称”？如果元素是子元素，如何引用它？

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.

Excel 文档的替代（和低于标准）解决方案是启动文档的“打开”并保存活动工作簿，但文件类型可能不同，因此该解决方案仅适用于特定文件类型。

Any help is appreciated.

任何帮助表示赞赏。

采纳答案by RyanL

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.

由于缺乏更好的答案，我在这里发布我的解决方案。“另存为”功能在不使用 SendKeys 的情况下似乎无法访问……这当然不是最佳选择，因为用户可以通过在进程运行时在桌面上积极工作来轻松地破坏目的。无论如何，这个过程是通过调用 Download() 过程、传递浏览器、文件名以及他们是否愿意替换已经存在的文件来启动的。如果没有传递文件名，则调用默认的“保存”功能，默认文件名将保存在默认文件夹中。这些数据是从 StackOverflow 和其他地方的各种来源积累和改编的，应该是 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

参考资料： SaveasDialog

True Condition

真实情况

Faidootdoot

费杜杜特

回答by Andrey

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

好吧，我通过谷歌搜索FileNameControlHost关键字解决了这个问题，因为保存文件对话框自动化在 Windows 10 中停止工作（它在 Windows 7 中工作）。并且自动化代码 withSendKeys不适用于具有非 ASCII 符号的路径。

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

回答by Sayali Akhade

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

私有声明 PtrSafe 函数 FindWindowEx Lib "user32" 别名 "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

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

参考需要： UIautomationclient microsoft DAo3.6 对象库 UIautomationclientpriv microsoft html 对象库 microsoft internet controls