VBA UI 自动化 - Internet Explorer "Save As"

Question

我正在使用 MS Access 和 Internet Explorer 10

我正在尝试每天自动下载一系列文档。文件类型可以不同。使用下面的代码，我设法将文档保存到一个临时文件夹中，但是我最终希望“另存为”并将文档保存在一个预先确定的文件夹中，该文件夹具有基于正在下载的文件的特定名称。

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

在创建 IUIAutomationCondition UIA_NamePropertyID 时，我尝试将“Save”替换为“Save As”、“SaveAs”等，并尝试了 TreeScope 枚举的不同迭代以及 IUIAutomationElement 的 .FindFirst 和 .FindAll 方法(FindAll 导致类型不匹配错误)。

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

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

任何帮助表示赞赏。

Answer 1

由于缺乏更好的答案，我在这里发布我的解决方案。如果不使用 SendKeys，“另存为”功能似乎无法 Access ……这当然不是最佳的，因为用户可以通过在进程运行时积极地在桌面上工作来轻松地达到目的。不管怎样，这个过程是通过调用 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

引用:
SaveasDialog

True Condition

Faidootdoot