消えると困るのでコピペ
自分環境ではIE窓検索がうまく行かない＆最終的に例外がでたけど押せるのは分かった。
Private Delegate Function D_EnumChildWindowsProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As IntPtr
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As IntPtr, ByVal hWnd2 As IntPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As IntPtr
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr
Private Const WM_ACTIVATE = &H6
Private Const BM_CLICK = &HF5
Private Const WM_GETTEXT = &HD
Private Const WM_QUIT = &H10
Private Const NAVDIR_NEXT = &H5
Private Const NAVDIR_FIRSTCHILD = &H7
Private Const CHILDID_SELF = &H0
Private Const OBJID_CLIENT = &HFFFFFFFC
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As IntPtr, ByVal dwId As IntPtr, _
ByRef riid As Guid, <MarshalAs(UnmanagedType.IUnknown)> ByRef ppvObject As Object) As IntPtr
Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As IntPtr,
ByVal cChildren As IntPtr, <[Out]()> ByVal rgvarChildren() As Object, ByRef pcObtained As IntPtr) As IntPtr
Private IID_IAccessible As Guid = New Guid(&H20400, 0, 0, {&HC0, 0, 0, 0, 0, 0, 0, &H46})
Sub FileDownLoad_Proc()
Dim strCaption As String
Dim PWnd As IntPtr
Dim cWnd As IntPtr
' 親ウィンドウ取得
strCaption = "○○○○ - Windows Internet Explorer"
While PWnd = 0
PWnd = FindWindowEx(0, 0, "IEFrame", strCaption)
System.Threading.Thread.Sleep(50)
End While
' 通知バーのハンドル
While cWnd = 0
cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
System.Threading.Thread.Sleep(50)
End While
' 通知バーボタン群のハンドル
Dim hChild As IntPtr = FindWindowEx(cWnd, 0&, "DirectUIHWND", vbNullString)
Dim objAcc As IAccessible = Nothing
AccessibleObjectFromWindow(hChild, OBJID_CLIENT, IID_IAccessible, objAcc)
If Not IsNothing(objAcc) Then
ClickPreserve(objAcc)
While cWnd = 0
cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
System.Threading.Thread.Sleep(50)
End While
SendMessage(cWnd, WM_QUIT, 0, 0&)
End If
End Sub
Private Sub ClickPreserve(ByVal acc As IAccessible)
Dim i As Long
Dim count = acc.accChildCount
Dim lst(count - 1) As Object
If count > 0 Then
AccessibleChildren(acc, 0, count, lst, 0)
If Not IsNothing(lst) Then
For i = LBound(lst) To UBound(lst)
With lst(i)
'On Error Resume Next
'Debug.Print("ChildCount: " & .accChildCount)
'Debug.Print("Value: " & .accValue(CHILDID_SELF))
'Debug.Print("Name: " & .accName(CHILDID_SELF))
'Debug.Print("Description: " & .accDescription(CHILDID_SELF))
'On Error GoTo 0
'保存ボタンを見つけたらクリック（デフォルトアクション）する
If .accName(CHILDID_SELF) = "保存" Then
System.Threading.Thread.Sleep(500)
.accDoDefaultAction(CHILDID_SELF)
System.Threading.Thread.Sleep(500)
End If
End With
ClickPreserve(lst(i)) '再帰
Next
End If
End If
End Subネタ元
