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
カテゴリー: VBA

0件のコメント

コメントを残す

アバタープレースホルダー

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください