> 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