Fatal编程技术网
  • vba/
  • VBA UI自动化-Internet Explorer“；另存为；

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

vba user-interface ms-access automation

VBA UI自动化-Internet Explorer“；另存为；,vba,user-interface,ms-access,automation,Vba,User Interface,Ms Access,Automation,我正在使用MS Access和Internet Explorer 10 我正在尝试每天自动下载一系列文档。文件类型可能不同。使用下面的代码，我成功地将文档保存到一个临时文件夹中，但是我最终希望“另存为”，并根据下载的文件将文档保存到一个具有特定名称的预定义文件夹中 Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2

我正在使用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时，我尝试过用“另存为”、“另存为”等替换“保存”，并尝试了树域枚举的不同迭代以及IUIAutomationElement的.FindFirst和.FindAll方法（FindAll导致类型不匹配错误）

我的问题是：这可以通过Treewalker的FindAll方法实现吗？如果两者中有一个，如何着手做这件事？如何找到UI元素的“名称”？如果元素是子元素，如何引用它

excel文档的另一种解决方案是启动文档的“打开”并保存活动工作簿，但文件类型可能不同，因此此解决方案仅适用于特定的文件类型

非常感谢您的帮助。

由于没有更好的答案，我将在这里发布我的解决方案。“另存为”功能在不使用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

选项显式
将PtrSafe函数FindWindowEx Lib“user32”别名“FindWindowExA”（ByVal hWnd1为LongPtr，ByVal hWnd2为LongPtr，ByVal lpsz1为String，ByVal lpsz2为String）声明为LongPtr
声明PtrSafe子睡眠库“kernel32”_
（ByVal的长度为毫秒）
声明PtrSafe函数findwindowlib“user32”别名“FindWindowA”_
（ByVal lpClassName作为字符串，ByVal lpWindowName作为字符串）作为LongPtr
声明PtrSafe函数setForeGroundIndow Lib“user32”_
（ByVal hWnd作为LongPtr）作为LongPtr
声明PtrSafe函数SendMessage Lib“user32”别名“SendMessageA”_
（ByVal hWnd为LongPtr，ByVal wMsg为Long，ByVal wParam为Long，lParam为任意）为Long
声明PtrSafe函数PostMessage Lib“user32”别名“PostMessageA”_
（ByVal hWnd为LongPtr，ByVal wMsg为Long，ByVal wParam为Long，lParam为任意）为Long
公用工程BM_点击=&HF5
Public Const WM_GETTEXT=&HD
Public Const WM_GETTEXTLENGTH=&HE
公共子下载（ByRef oBrowser作为InternetExplorer_
ByRef sFilename作为字符串_
ByRef（以布尔形式替换）
如果sFilename=“”，则
呼叫保存（oBrowser）
其他的
调用SaveAs（oBrowser、sFilename、bReplace）
如果结束
端接头
'https://stackoverflow.com/questions/26038165/automate-saveas-dialouge-for-ie9-vba
公共子存储（ByRef oBrowser作为InternetExplorer）
Dim Automation作为iUI自动化
将WindowElement调暗为IUIAutomationeElement
调暗按钮作为IUIAutomationeElement
变暗hWnd为长PTR
Set AutomationObj=新CUI自动化
hWnd=oBrowser.hWnd
hWnd=FindWindowEx（hWnd，0，“帧通知栏”，vbNullString）
如果hWnd=0，则退出Sub
设置WindowElement=AutomationObj.ElementFromHandle（ByVal hWnd）
Dim iCnd作为IUIAutomation条件
设置iCnd=AutomationObj.CreatePropertyCondition（UIA_NamePropertyId，“保存”）
Set Button=WindowElement.FindFirst（TreeScope\u子树，iCnd）
Dim InvokePattern作为IUIAutomationInvokePattern
设置InvokePattern=Button.GetCurrentPattern（UIA_InvokePatternId）
InvokePattern.Invoke
端接头
子存储组件（ByRef oBrowser作为InternetExplorer_
sFilename作为字符串_
bReplace（作为布尔值）
'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
作为IUIAutomationElementArray的Dim等位基因
作为IUIAutomationeElement的Dim元素
Dim InvokePattern作为IUIAutomationInvokePattern
Dim iCnd作为IUIAutomation条件
Dim Automation作为iUI自动化
作为IUIAutomationeElement的Dim FrameElement
Dim bfiles以布尔形式存在
变暗hWnd为长PTR
'创建自动化对象
Set AutomationObj=新CUI自动化
等待秒3
'从浏览器获取句柄
hWnd=oBrowser.hWnd
'获取帧通知栏的句柄
hWnd=FindWindowEx（hWnd，0，“帧通知栏”，vbNullString）
如果hWnd=0，则退出Sub
'从句柄获取元素
Set FrameElement=AutomationObj.ElementFromHandle（ByVal hWnd）
'获取分割按钮元素
设置iCnd=AutomationObj.CreatePropertyCondition（UIA\u ControlTypePropertyId，UIA\u SplitButtonControlTypeId）
Set-Allegements=FrameElement.FindAll（TreeScope_子树，iCnd）
'应该只有两个拆分按钮
如果等位基因长度=2，则
'获取第二个拆分按钮，单击该按钮时显示其他三个“保存”、“另存为”、“保存”和“打开”
Set Element=allegements.GetElement（1）
'单击第二个旋转按钮以显示保存、另存为、保存和打开选项
设置InvokePattern=Element.GetCurrentPattern（UIA_InvokePatternId）
InvokePattern.Invoke
'选项卡从默认打开到保存，向下两次单击另存为
'显示另存为窗口
发送键“{TAB}”
SendKeys“{DOWN}”
SendKeys“{ENTER}”

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



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