VBAでWindowsアプリ「メモ帳」を操作してみた・SendMessage/PostMessage編
この動画のマクロはWindows11/Office2013で作成してます。
メモ帳のidとかはWindows11とそれ以前のWindowsとでは異なってる可能性がありますので、
Windows11以外で動かす場合はspyxx_amd64.exeでidを確認しコード修正をする必要があります。
Option Explicit
'64ビットOffice用です。
'32ビット版では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 hMemochoParent As Long, ByVal hMemochoChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hMemocho As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hMemocho As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const WM_COMMAND = &H111
Const WM_CLOSE = &H10
Const WM_SETTEXT As Long = &HC
Const WM_GETTEXT As Long = &HD
Const WM_GETTEXTLENGTH As Long = &HE
Const EM_REPLACESEL As Long = &HC2
Const EM_SETMODIFY As Long = &HB9
Const BM_CLICK As Long = &HF5
Const VK_RETURN As Long = &HD 'Enterキー
Const WM_KEYDOWN As Long = &H100
Const WM_KEYUP As Long = &H101
Sub Memo2()
Dim hMemocho As Long
Dim hNamae As Long
Dim hChild As Long
Dim nLen As Long
Dim rtn As Long
Dim xStr As String
Dim xFikename As String
Dim fso, CurrentDirectory, i
'---------------------------------------------------------------------------
'エクセルファイルのあるパス名を取得
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = ActiveWorkbook.Path
' メモ帳の起動
Call Shell("notepad.exe", vbNormalFocus)
Do While hMemocho = 0
hMemocho = FindWindowEx(0, 0, "Notepad", vbNullString)
'DoEvents
Sleep 100 'DoEventsだとうまく動かないのでSleepを使った
Loop
'Windows11付属のメモ帳の編集エリア
hChild = FindWindowEx(hMemocho, 0&, "RichEditD2DPT", vbNullString)
For i = 1 To 2
xStr = Cells(i, 2).Value
rtn = SendMessage(hChild, EM_REPLACESEL, 0, xStr & vbCrLf) ' 文字列を送信
Next
rtn = SendMessage(hChild, EM_SETMODIFY, 0, 0&) '変更フラグOFF
'メモ帳の編集エリアから文字列を読み取る
' コマンドラインの文字列の長さ 0&はLong型の0を意味する
nLen = SendMessage(hChild, WM_GETTEXTLENGTH, 0, 0&)
' 文字列 +1 の長さの空白文字列を用意 +1はNullコード(&H00)
xStr = String(nLen + 1, vbNullChar)
rtn = SendMessage(hChild, WM_GETTEXT, nLen + 1, xStr)
Debug.Print xStr
'---------------------------------------------------------------------------
' 「名前を付けて保存」Windowの処理
' このエクセルファイルと同じフォルダーに"abc.txt"という名前で保存する
'
'保存しようとするファイルが存在してると、上書きを聞いてくるので
'予めファイルがあったら削除しておく。
xFikename = fso.BuildPath(CurrentDirectory, "abc.txt")
If fso.FileExists(xFikename) Then
fso.DeleteFile xFikename, True
End If
rtn = PostMessage(hMemocho, WM_COMMAND, &H4, 0&) 'ファイル - 名前をつけて保存
Do While hNamae = 0 Or hChild = 0
hNamae = FindWindowA(vbNullString, "名前を付けて保存")
hChild = FindWindowEx(hNamae, 0&, "DUIViewWndClassName", vbNullString)
hChild = FindWindowEx(hChild, 0&, "DirectUIHWND", vbNullString)
hChild = FindWindowEx(hChild, 0&, "FloatNotifySink", vbNullString)
hChild = FindWindowEx(hChild, 0&, "ComboBox", vbNullString)
'DoEvents
Sleep 100 'DoEventsだとうまく動かないのでSleepを使った
Loop
xStr = xFikename
rtn = SendMessage(hChild, WM_SETTEXT, 0, xFikename) ' 文字列を送信
'保存(&S)を押す
hChild = FindWindowEx(hNamae, 0&, "Button", "保存(&S)")
rtn = PostMessage(hChild, BM_CLICK, 0, 0&)
''Enterキーを押す
'rtn = PostMessage(hChild, WM_KEYDOWN, VK_RETURN, 0&)
'rtn = PostMessage(hChild, WM_KEYUP, VK_RETURN, 0&)
'メモ帳の終了
'rtn = PostMessage(hMemocho, WM_COMMAND, &H7, 0&) 'ファイル - 終了
rtn = PostMessage(hMemocho, WM_CLOSE, 0, 0&) 'アプリケーションを終了
End Sub
0件のコメント