UIAutomationで、invokeが有効にならない

お世話になります。
事情があって、vbプログラム上から、win10「既定のブラウザ」をIEに切り替える必要があります。
最初はレジストリ操作を試みました。レジストリの変更はできましたが、
実際のブラウザはかわらずじまい。
そこで、「設定」アプリから、「既定のアプリ」->webブラウザをUIAutomationにて切り替える
ことをチャレンジしています

webBrowserのボタンを捕まえるところはうまく行ったのですが、
invokeしても「設定アプリ」が反応しません

ちなみに、Inspect.exeにて、
webbrowser,internet Explorer buttonにaction->invoke.invokeすると、きちんとポップアップを開きます。

このinvokeの方法、その後のポップアップの処理について
何かヒントでもありますでしょうか



'設定アプリを起動する
strCMD = "start ms-settings:defaultapps"
Set objExec = WSH.Exec("cmd.exe /c" & strCMD)
'ハンドル
hWwnd = FindWindow(vbNullString, "設定")

'ウィンドウハンドルからエレメントを取得
Set uiElm = uiAuto.ElementFromHandle(ByVal hwnd)

'以下冗長ですが、webbrowserのボタンまで下ります
Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId,"Windows.UI.Core.CoreWindow")
Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)


Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "LandmarkTarget")
Set uiElmAr = uiElm.FindAll(TreeScope_Children, uiCnd)
'2番めの"group"
Set uiElm = uiElmAr.GetElement(1)

Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "ScrollViewer")
Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)

Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "GroupItem")
Set uiElm = uiElm.FindFirst(TreeScope_Children, uiCnd)

Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "Button")
Set uiElmAr = uiElm.FindAll(TreeScope_Children, uiCnd)
'Buttonの6番目
Set uiElm = uiElmAr.GetElement(5)

'**********ここ
Set uiInvoke = uiElm.GetCurrentPattern(UIA_InvokePatternId)
uiInvoke.Invoke

> vbプログラム上から
Codeer.Friendly を使うのかな…と思いきや、 .NET ではない方の Visual Basic なのですね。
手元に VB6 が無いので確認できず。


> win10「既定のブラウザ」をIEに切り替える必要があります。
2023/02/15 のパッチ更新以降は、IE を使えなくなるのでは…?
Windows 10 の LTSB/LTSC は別として。
https://forest.watch.impress.co.jp/docs/special/1452848.html


> ちなみに、Inspect.exeにて、
> webbrowser,internet Explorer buttonにaction->invoke.invokeすると、きちんとポップアップを開きます。
うーん。なぜでしょうね。
x86\Inspect.exe / x64\Inspect.exe のいずれでも Invoke できるみたいですし、
Inspect 自体は「管理者として実行」しているわけでもないはずなので
VB からであっても、手順さえ正しければ呼び出せそうなものなのですが。
（ただし、提示されたコードが適切かどうかまでは読み解けていません）

魔界の仮面弁士様、お返事ありがとうざいます。

>2023/02/15 のパッチ更新以降は、IE を使えなくなるのでは…?
げっ、そんな早いのですが。

プログラム自身は
uiInvoke.Invoke 
のところで、[設定アプリ]が、一瞬光って、反応しているのです
実際の[設定アプリ]はマウスクリックするとブラウザ一覧をしている
ポップアップが起動しますが、他のエリアをクリックすると
このポップアップは消えてしまいます。
この辺が問題なのかなと思います。

invokeってアバウトなのですが、
マウスオーバーとかマウスクリックを具体的に
指示できませんでしょうか。

> uiInvoke.Invoke 
> のところで、[設定アプリ]が、一瞬光って、反応しているのです

VB6 が無いので VB.NET で試してみましたが、同じ状況ですね…。

Dim GetChild As Func(Of AutomationElement, AutomationProperty, String, AutomationElement) =

    Function(u, p, s) u.FindFirst(TreeScope.Children, New PropertyCondition(p, s))

Dim GetChildren As Func(Of AutomationElement, AutomationProperty, String, AutomationElementCollection) =

    Function(u, p, s) u.FindAll(TreeScope.Children, New PropertyCondition(p, s))



Dim proc = Process.GetProcesses().FirstOrDefault(Function(x) x.MainWindowTitle = "設定")

Dim uiElm = AutomationElement.FromHandle(proc.MainWindowHandle)

Dim uiCoreWindow = GetChild(uiElm, AutomationElement.ClassNameProperty, "Windows.UI.Core.CoreWindow")

Dim uiLandmarkTarget = GetChildren(uiCoreWindow, AutomationElement.ClassNameProperty, "LandmarkTarget")(1)

Dim uiViewer = GetChild(uiLandmarkTarget, AutomationElement.AutomationIdProperty, "ItemsControlScrollViewer")

Dim uiGroup = GetChild(uiViewer, AutomationElement.ClassNameProperty, "GroupItem")

Dim uiButton = GetChild(uiGroup, AutomationElement.AutomationIdProperty, "SystemSettings_DefaultApps_Browser_Button")



DirectCast(uiButton.GetCurrentPattern(ScrollItemPatternIdentifiers.Pattern), ScrollItemPattern).ScrollIntoView()

DirectCast(uiButton.GetCurrentPattern(InvokePattern.Pattern), InvokePattern).Invoke()

> マウスオーバーとかマウスクリックを具体的に
> 指示できませんでしょうか。

そちらは SendInput API で。

http://nonsoft.la.coocan.jp/SoftSample/VB.NET/SampleSendInput.html
https://liclog.net/mouse_event-function-vba-api/

>> 2023/02/15 のパッチ更新以降は、IE を使えなくなるのでは…?
> げっ、そんな早いのですが。
それでなくとも、プログラムからの変更は推奨されていませんので
運用方針を見直すことをお奨めしておきます。


> レジストリの変更はできましたが、実際のブラウザはかわらずじまい。

もしも組織内において、利用者に同じ設定を共通的に配布する目的ならば、
『グループポリシー』を使って設定するのが正攻法です。

（ただし、ユーザー側の変更は禁じられることになります
https://jpwinsup.github.io/blog/2021/06/22/UserInterfaceAndApps/how-to-set-DefaultApps/


> uiInvoke.Invoke 
> のところで、[設定アプリ]が、一瞬光って、反応しているのです
UIAutomation で Invoke できなかった件の調査は、週末にもう少し足掻いてみます。
AttachThreadInput してみたら変わらないかな…。

Win10 + VB6(32bit) 環境は無いので、確認するとしても
Win11 + VBA(64bit) 環境か Win10 + VB.NET 環境になってしまうのですが。

数々のレスありがとうございます。

>> 2023/02/15 のパッチ更新以降は、IE を使えなくなるのでは…?
> げっ、そんな早いのですが。
それでなくとも、プログラムからの変更は推奨されていませんので
運用方針を見直すことをお奨めしておきます。

いわゆるBtoBの発注サイトなのです。
いままでIEベースの自動化プログラムが生きているので
そのまま対応できればなあという感じです。
IE終了が思ったより早いので
これからちまちま、Edge対応に切り替える予定ですが、
ちょっと技術的に興味があるので
週末に期待しています。

もちろん、何もなくてもそれはそれで感謝です。

"SystemSettings_DefaultApps_Browser_Button"
でググってみたら、C# なコードを発見しました。
https://github.com/sampalmer/set-default-browser/blob/master/Settings%20App%20%2B%20UI%20Automation/Program.cs#L35

タイムアウト設定が追加されてはいるものの、見た感じでは単純に
InvokePattern で Invoke しているだけに見えるのですけれどねぇ…。


そのあとは "DefaultAppsFlyoutPresenter" をたどって
"Google Chrome" という Name を持つ ButtonControl を探して Invoke 、と。
（その後の "Switch anyway" は何を操作しているのか不明）

(削除されました)

> Win10 + VB6(32bit) 環境は無いので、確認するとしても
> Win11 + VBA(64bit) 環境か Win10 + VB.NET 環境になってしまうのですが。

Win11 だと設定画面の階層構造が異なるので、Win10 + VBA(32bit) で書いてみました。

InvokePattern.Invoke や LegacyIAccessiblePattern.DoDefaultAction だと
ボタン操作にならない件については原因がわからなかったので、回避策として
SendKeys でスペースキーを送り付ける方式に切り替えています。

※初回実行時は Edge を推奨するポップアップが表示されて、違う動きになるかもしれません。

Option Explicit

Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, ByRef pHandles As LongPtr, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long

Private Const QS_ALLINPUT As Long = &HFF&

Private Const WAIT_OBJECT_0 As Long = 0&

Private Declare PtrSafe Function FindWindowW Lib "user32" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr



Public Sub SetDefaultBrowser_Win10IE()

    CreateObject("WScript.Shell").Run "cmd /c start ms-settings:defaultapps", vbNormalFocus, True

    WaitSeconds 3

    

    Dim hwndWin As LongPtr

    hwndWin = FindWindowW(StrPtr("ApplicationFrameWindow"), StrPtr("設定"))

    

    Dim ua As CUIAutomation8: Set ua = New CUIAutomation8

    Dim ae1 As IUIAutomationElement9: Set ae1 = ua.ElementFromHandle(ByVal hwndWin)

    Dim ae2 As IUIAutomationElement9: Set ae2 = ae1.FindFirst(TreeScope_Children, ua.CreatePropertyCondition(UIA_ClassNamePropertyId, "Windows.UI.Core.CoreWindow"))

    Dim ae3 As IUIAutomationElement9: Set ae3 = ae2.FindFirst(TreeScope_Children, ua.CreatePropertyCondition(UIA_LandmarkTypePropertyId, UIA_MainLandmarkTypeId))

    Dim ae4 As IUIAutomationElement9: Set ae4 = ae3.FindFirst(TreeScope_Descendants, ua.CreatePropertyCondition(UIA_AutomationIdPropertyId, "SystemSettings_DefaultApps_Browser_Button"))

    Dim ae5 As IUIAutomationElement9: Set ae5 = ae4.FindFirst(TreeScope_Children, ua.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TextControlTypeId))

    Dim currentBrowser As String: currentBrowser = ae5.CurrentName

    Debug.Print "currentBrowser = '" & currentBrowser & "'"

    If currentBrowser = "Internet Explorer" Then

        Debug.Print "既に IE 設定になっています"

    Else

        ' -- 反応はしているが、ボタン操作としては認識されなかった 

        'Set pi = ae4.GetCurrentPattern(UIA_InvokePatternId) : pi.Invoke 

        'Set pl = ae4.GetCurrentPattern(UIA_LegacyIAccessiblePatternId) : pl.DoDefaultAction 

        

        ' -- 代替策として Space キーを送出する 

        ae4.SetFocus

        SendKeys " ", True



        WaitSeconds 2

        Dim ae6 As IUIAutomationElement9: Set ae6 = ae2.FindFirst(TreeScope_Descendants, ua.CreateAndCondition( _

           ua.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_ButtonControlTypeId), _

           ua.CreatePropertyCondition(UIA_NamePropertyId, "Internet Explorer")))

        If ae6 Is Nothing Then

            Debug.Print "IE ボタンが見つかりません"

        ElseIf Not ae6.GetCurrentPropertyValue(UIA_IsEnabledPropertyId) Then

            Debug.Print "IE ボタンを操作できません"

        Else

            ' -- 反応はしているが、ボタン操作としては認識されなかった 

            'Set pi = ae6.GetCurrentPattern(UIA_InvokePatternId) : pi.Invoke 

            'Set pl = ae6.GetCurrentPattern(UIA_LegacyIAccessiblePatternId) : pl.DoDefaultAction 

            

            ' -- 代替策として Space キーを送出する 

            ae6.SetFocus

            SendKeys " ", True

            Debug.Print "IE ボタンを押してみました"

            

            ' -- 変更結果の確認 

            'WaitSeconds 2 

            'Debug.Print "changed: '" & currentBrowser & "'　=> '" & ae5.CurrentName & "'" 

        End If

    End If

End Sub



Public Sub WaitSeconds(ByVal sec As Integer)

    Dim limit As Date

    limit = DateAdd("s", sec, Now)

    Do Until limit <= Now

        If MsgWaitForMultipleObjects(0&, ByVal CLngPtr(0), 0&, 55&, QS_ALLINPUT) = WAIT_OBJECT_0 Then

            DoEvents

        End If

    Loop

End Sub

魔界の仮面弁士 様　ありがとうございます。
ヒントどころか完成ソースですね。 m(_ _)m
一気に実行したら無事動作しました。

UIAutomationはwebを検索しても断片的な情報しか出てこないので
ae6のような指定方法 = CreatePropertyCondition のand結合？が出てくると
非常に勉強になります。

重ね重ねありがとうございました。