VBAでWindowsアプリ「メモ帳」を操作してみた・UI Automation

VBAでWindowsアプリ「メモ帳」を操作してみた・UI Automation
この動画のマクロはWindows11/Office2013で作成してます。
メモ帳のidとかはWindows11とそれ以前のWindowsとでは異なってる可能性がありますので、
Windows11以外で動かす場合はInspect.exeでidを確認しコード修正をする必要があります。

Option Explicit
' 32ビット版Excelの場合はPtrSafeは不要ですので、削除してみてください。
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "User32.dll" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function MessageBoxTimeoutA Lib "user32" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageID As Long, ByVal dwMilliseconds As Long) As Long

Sub Memo()
    Dim str_Title, i, fso, CurrentDirectory, xFikename
    Dim hWnd As Long
    Dim uiAuto As CUIAutomation
    Dim iCnd As IUIAutomationCondition
    Dim iValuePattern As IUIAutomationValuePattern
    '---------------------------------------------------------------------------
    'エクセルファイルのあるパス名を取得
    Set fso = CreateObject("Scripting.FileSystemObject")
    CurrentDirectory = ActiveWorkbook.Path
    
    '---------------------------------------------------------------------------
    ' メモ帳の起動
        Call Shell("notepad.exe", vbNormalFocus)
        '1秒停止
        Call Sleep(1000)
        
        'タイトルでアプリを見つける
        'hWnd = FindWindowA(vbNullString, "タイトルなし - メモ帳")
        'クラス名で探す
        hWnd = FindWindowEx(0, 0, "Notepad", vbNullString)
        If hWnd = 0 Then
            Call MessageBoxTimeoutA(0&, "メモ帳がみつかりません", "hWndエラー", vbMsgBoxSetForeground, 0&, 10000)
            Exit Sub
        End If
    
        'メモ帳の」Windowのエレメントを探す
        Dim elmMemocho As IUIAutomationElement
    
        Set uiAuto = New CUIAutomation
        Set elmMemocho = uiAuto.ElementFromHandle(ByVal hWnd)
        If elmMemocho Is Nothing Then
            i = MessageBoxTimeoutA(0&, "TimelineView" & Chr(13) & "がみつかりません", "FindFirstエラー", vbMsgBoxSetForeground, 0&, 10000)
            Exit Sub
        End If
    
    '---------------------------------------------------------------------------
    'メモ帳に文字列を書く
        Dim elmMemocho_edit As IUIAutomationElement
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "RichEditD2DPT")
        Set elmMemocho_edit = elmMemocho.FindFirst(TreeScope_Subtree, iCnd)
        Set iValuePattern = elmMemocho_edit.GetCurrentPattern(UIA_ValuePatternId)
        ' B1,B2セルの内容をメモ帳に書く
        iValuePattern.SetValue Range("B1").Value & Chr(13) & Range("B2").Value
        ' メモ帳の編集内容を見るにはCurrentValue
        'Debug.Print iValuePattern.CurrentValue
    
    '---------------------------------------------------------------------------
    '名前を付けて保存する
    '
        '「ファイル」のメニューのエレメントを探す
        Dim elmMemocho_m0 As IUIAutomationElement
        Dim elmMemocho_m1 As IUIAutomationElement
        Dim elmMemocho_m2 As IUIAutomationElement
        Dim elmMemocho_m3 As IUIAutomationElement
        
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "Windows.UI.Input.InputSite.WindowClass")
        Set elmMemocho_m0 = elmMemocho.FindFirst(TreeScope_Subtree, iCnd)
        
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_AutomationIdPropertyId, "MenuBar")
        Set elmMemocho_m1 = elmMemocho_m0.FindFirst(TreeScope_Subtree, iCnd)
    
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "ファイル")
        Set elmMemocho_m2 = elmMemocho_m1.FindFirst(TreeScope_Subtree, iCnd)
        
        '「ファイル」のメニューを押す
        Dim InvokePattern As IUIAutomationInvokePattern
        Set InvokePattern = elmMemocho_m2.GetCurrentPattern(UIA_InvokePatternId)
        elmMemocho_m2.SetFocus
        InvokePattern.Invoke
        
        '「ファイル」のメニュー配下の「名前を付けて保存」のエレメントを探す
    
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "名前を付けて保存")
        Do
            Set elmMemocho_m3 = elmMemocho.FindFirst(TreeScope_Subtree, iCnd)
            DoEvents
        Loop While elmMemocho_m3 Is Nothing
        
        '「名前を付けて保存」のメニューを押す
        
        elmMemocho_m3.SetFocus
        Set InvokePattern = elmMemocho_m3.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
    
    '---------------------------------------------------------------------------
    '  「名前を付けて保存」Windowの処理
    '  このエクセルファイルと同じフォルダーに"abc.txt"という名前で保存する
    '
    
        '保存しようとするファイルが存在してると、上書きを聞いてくるので
        '予めファイルがあったら削除しておく。
        xFikename = fso.BuildPath(CurrentDirectory, "abc.txt")
        If fso.FileExists(xFikename) Then
            fso.DeleteFile xFikename, True
        End If
    
        '「名前を付けて保存」Windowのエレメントを探す
        Dim elmMemocho_s0 As IUIAutomationElement
        Dim elmMemocho_s1 As IUIAutomationElement
        Dim elmMemocho_s2 As IUIAutomationElement
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "名前を付けて保存")
        Do
            Set elmMemocho_s0 = elmMemocho.FindFirst(TreeScope_Subtree, iCnd)
            DoEvents
        Loop While elmMemocho_s0 Is Nothing
        
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "DUIViewWndClassName")
        Set elmMemocho_s1 = elmMemocho_s0.FindFirst(TreeScope_Subtree, iCnd)
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "AppControlHost")
        Set elmMemocho_s2 = elmMemocho_s1.FindFirst(TreeScope_Subtree, iCnd)
        
        Set iValuePattern = elmMemocho_s2.GetCurrentPattern(UIA_ValuePatternId)
        'ファイル名の送信
        iValuePattern.SetValue xFikename
        
        '保存ボタンを押す
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "保存(S)")
        Set elmMemocho_s1 = elmMemocho_s0.FindFirst(TreeScope_Subtree, iCnd)
        elmMemocho_s1.SetFocus
        Set InvokePattern = elmMemocho_s1.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke
    
    '---------------------------------------------------------------------------
    'メモ帳の終了
        '「ファイル」のメニューを押す
        Set InvokePattern = elmMemocho_m2.GetCurrentPattern(UIA_InvokePatternId)
        elmMemocho_m2.SetFocus
        InvokePattern.Invoke
        
        '「ファイル」のメニュー配下の「名前を付けて保存」のエレメントを探す
    
        Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "終了")
        Do
            Set elmMemocho_m3 = elmMemocho.FindFirst(TreeScope_Subtree, iCnd)
            DoEvents
        Loop While elmMemocho_m3 Is Nothing
        
        '「終了」のメニューを押す
        elmMemocho_m3.SetFocus
        Set InvokePattern = elmMemocho_m3.GetCurrentPattern(UIA_InvokePatternId)
        InvokePattern.Invoke

End Sub