IE通知バー制御

Class1.cls

Option Explicit
Implements IUIAutomationEventHandler
Private Sub IUIAutomationEventHandler_HandleAutomationEvent(ByVal sender As UIAutomationClient.IUIAutomationElement, ByVal eventId As Long)

    Dim iElemFound As IUIAutomationElement
    Set iElemFound = GetElement(o, sender, "はい(Y)", 0)
    If iElemFound Is Nothing Then Exit Sub

    If iElemFound.CurrentName = "はい(Y)" Then
        Dim InvokePattern As IUIAutomationInvokePattern
        Set InvokePattern = iElemFound.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
    End If
    flg = True
    
End Sub

Module3.bas

Option Explicit

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
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Private Const WM_SYSCHAR = &H106
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public o As IUIAutomation
Public flg As Boolean

Sub main()
    
    flg = False
    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.Navigate "実際のURL"

    While ie.busy Or ie.ReadyState <> 4
        DoEvents
        Sleep 1&
    Wend
    何かの要素.Click

    Dim hWndIE As LongPtr
    Dim h As LongPtr
    hWndIE = ie.hwnd
    h = 0
    Do
        DoEvents
        Sleep 1&
        h = FindWindowEx(hWndIE, 0, "Frame Notification Bar", vbNullString)
    Loop Until h

    '通知バー表示待ち
    Do
        DoEvents
        Sleep 1&
    Loop Until IsWindowVisible(h)

    Set o = New CUIAutomation
    Dim e As IUIAutomationElement
    Set e = o.ElementFromHandle(ByVal h)

    Dim iElemFound As IUIAutomationElement

    Set iElemFound = GetElement(o, e, "", UIA_SplitButtonControlTypeId)

    Dim TreeWalker As IUIAutomationTreeWalker
    Set TreeWalker = o.ContentViewWalker
    Set iElemFound = TreeWalker.GetFirstChildElement(iElemFound)

    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = iElemFound.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke

    Dim hDlg As LongPtr
    Do
        DoEvents
        hDlg = FindWindow("#32768", vbNullString)
    Loop While hDlg = 0
    PostMessage hDlg, WM_SYSCHAR, Asc("A"), 0

    hDlg = 0
    Do
        DoEvents
        hDlg = FindWindow("#32770", "名前を付けて保存")
    Loop While hDlg = 0

    Dim strPath As String
    strPath =
    If Dir$(strPath) <> "" Then
        Set e = o.GetRootElement

        Dim cls As Class1
        Set cls = New Class1
        o.AddAutomationEventHandler UIA_Window_WindowOpenedEventId, e, TreeScope_Subtree, Nothing, cls
        Call SetDialog(strPath, hDlg)

        Do
            DoEvents
        Loop Until flg

        o.RemoveAllEventHandlers

    Else
        Call SetDialog(strPath, hDlg)
    End If
    Debug.Print "終了"

End Sub


Sub SetDialog(ByVal strPath As String, hwnd As LongPtr)

    Dim iElemFound As IUIAutomationElement
    Dim e As IUIAutomationElement
    Set e = o.ElementFromHandle(ByVal hwnd)

    Set iElemFound = Nothing
    Do
        DoEvents
        Sleep 500&
        Set iElemFound = GetElement(o, e, "ファイル名:", UIA_EditControlTypeId)
    Loop Until Not iElemFound Is Nothing

    If Not iElemFound Is Nothing Then
        Dim iValuePattern As IUIAutomationValuePattern
        Set iValuePattern = iElemFound.GetCurrentPattern(UIA_ValuePatternId)
        iValuePattern.SetValue strPath
        Set iElemFound = GetElement(o, e, "保存(S)", 0)

        If Not iElemFound Is Nothing Then
            Dim InvokePattern As IUIAutomationInvokePattern
            Set InvokePattern = iElemFound.GetCurrentPattern(UIA_InvokePatternId)
            InvokePattern.Invoke
        End If
    End If

End Sub

Public Function GetElement(iUIA As IUIAutomation, _
                           pElement As IUIAutomationElement, _
                           ByVal strName As String, _
                           ctlType As Long) As IUIAutomationElement

    Dim iCnd As IUIAutomationCondition
    Dim NameCdn As IUIAutomationCondition
    Dim Condition As IUIAutomationCondition

    Select Case True
    Case strName <> "" And ctlType > 0
        Set iCnd = iUIA.CreatePropertyCondition(UIA_ControlTypePropertyId, ctlType)
        Set NameCdn = iUIA.CreatePropertyCondition(UIA_NamePropertyId, strName)
        Set Condition = iUIA.CreateAndCondition(iCnd, NameCdn)
    Case strName <> ""
        Set Condition = iUIA.CreatePropertyCondition(UIA_NamePropertyId, strName)
    Case ctlType > 0
        Set Condition = iUIA.CreatePropertyCondition(UIA_ControlTypePropertyId, ctlType)
    End Select
    Set GetElement = pElement.FindFirst(TreeScope_Subtree, Condition)

End Function