Skip to content

Instantly share code, notes, and snippets.

@kumatti1
Last active Feb 24, 2020
Embed
What would you like to do?
IE通知バー制御
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
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment