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
「VBAでWindowsアプリ「メモ帳」を操作してみた・UI Automation」への1件の返信
[…] VBAでWindowsアプリ「メモ帳」を操作してみた・UI Automation […]