[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『SendMessageでダイアログにファイルパスを送りたい』（VBA勉強中）
ローカルアプリをVBAで操作できるようにしたいです。
WndowsAPIを使用して、ローカルアプリを操作しています。
ローカルアプリ内のダイアログにテキストファイルAのフルパスをSendMessageで送ろうとしていますが、
下記のコードを実行してもフルパスを送る事ができません。
Private Const WM_SETTEXT As String = &HC
戻り値=SendMessage(エディタのハンドル, WM_SETTEXT, 0, フルパス) ←nullが送られる。戻り値=1
戻り値=SendMessage(エディタのハンドル, WM_SETTEXT, 0, Byval フルパス) ←反応なし。戻り値=0
エディタのハンドル、フルパス共にdebug.printで確認しても問題はなさそうです。
原因・解決方法をご教授いただきたいです。
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
勘ですけど、 > エディタのハンドル
ってのが > ローカルアプリ内のダイアログ を正確に指せてないのではないかなぁと。(ローカルアプリ自体のハンドルだったりとかね)
例えば[メモ帳]の編集領域に文字列を送り付けようと思ったら、 [メモ帳]のハンドルじゃなくって、その配下の[Edit]クラスの子ウインドウを指定しないとダメですよね? (さもないと編集領域に文字が入らず、[メモ帳]のタイトルバーが書き変わってしまったりとか)
そこら辺は大丈夫ですかね? (こればっかりはご自身で調べて確認するしかないですから...)
命令文の方は
Declare で第4引数[lParam]を「(ByVal無し) As Any」で宣言しているなら
> 戻り値=SendMessage(エディタのハンドル, WM_SETTEXT, 0, ByVal フルパス)
↑こっちの方が正しいっぽいです。
ByVal付けなかったら指定通りの文字列が届かない模様。
（白茶） 2023/06/07(水) 19:16:07
＞命令文の方は
ありがとうございます。
Byvalなしで宣言しているので、ByVal フルパス ということですね。
（VBA勉強中） 2023/06/08(木) 10:09:27
そうなんですね
まあ、私でお力になれる事はなさそうなのは承知の上で、 とは言え、せっかくだしちょっとだけ「にぎやかし」のつもりで、^^; 私が愛用してるエディタ(TeraPad)で再現実験を行ってみました。
TeraPad公式サイト
https://tera-net.com/
▼こんなモジュールを準備しておく
Rem ************************************************************************************************************************
Rem 標準モジュール
Rem ************************************************************************************************************************
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongLong) As LongPtr
#Else
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
#End If
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As Collection) As Long 'ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vkey As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Rem Window Messages
Private Const WM_SETTEXT = &HC&
Rem Edit Control Messages
Private Const EM_REPLACESEL = &HC2&
Rem =================================================================================================================
Private aCurPos As POINTAPI, sw As Boolean
Rem =================================================================================================================
#If Win64 Then
Private Function PointToLongLong(Point As POINTAPI) As LongLong
Dim ll As LongLong
Dim cbLongLong As LongPtr
cbLongLong = LenB(ll)
If LenB(Point) = cbLongLong Then
CopyMemory ll, Point, cbLongLong
End If
PointToLongLong = ll
End Function
#End If
Rem =================================================================================================================
Property Get PointWindow() As LongPtr
#If Win64 Then
PointWindow = WindowFromPoint(PointToLongLong(aCurPos))
#Else
PointWindow = WindowFromPoint(aCurPos.X, aCurPos.Y)
#End If
End Property
Private Sub Observer()
Dim h As LongPtr, s As String
[A1].Value = "監視中..."
[B1:D1].Value = [{"hWnd","WindowText","ClassName"}]
[A2].Value = "PointWindow"
Do While sw
GetCursorPos aCurPos
h = PointWindow
[B2] = h
s = String$(&H20, vbNullChar)
GetWindowText h, s, &H20
[C2] = s
s = String$(&H20, vbNullChar)
GetClassName h, s, &H20
[D2] = s
If GetAsyncKeyState(vbKeyEscape) <> 0 Then sw = False
DoEvents
Sleep &H10&
Loop
[A1].Value = Empty
End Sub
Rem =================================================================================================================
Private Function EnumChildProc(ByVal hwnd As LongPtr, ByVal lParam As Collection) As Boolean
lParam.Add hwnd
EnumChildProc = True
End Function
Sub GetChildWindows(TargethWnd As LongPtr)
Dim c As Collection
Set c = New Collection
Call EnumChildWindows(TargethWnd, AddressOf EnumChildProc, c)
If c.Count = 0 Then Exit Sub
Dim i As Long, s As String, t As String
ReDim v(-1 To c.Count, 0 To 3)
v(-1, 1) = "hWnd"
v(-1, 2) = "WindowText"
v(-1, 3) = "ClassName"
v(0, 0) = "PointWindow"
v(0, 1) = TargethWnd
s = String$(&H20, vbNullChar)
t = s
GetClassName TargethWnd, s, &H20
GetWindowText TargethWnd, t, &H20
v(0, 2) = t
v(0, 3) = s
For i = 1 To c.Count
s = String$(&H20, vbNullChar)
t = s
GetClassName c(i), s, &H20
GetWindowText c(i), t, &H20
v(i, 0) = i
v(i, 1) = c(i)
v(i, 2) = t
v(i, 3) = s
Next
Workbooks.Add
[A1:D3].Resize(c.Count + 2).Value = v
End Sub
Rem =================================================================================================================
Sub Btn1_Click()
sw = Not sw
If sw Then Call Observer
End Sub
Sub Btn2_Click()
If [B2].Value = 0 Then Exit Sub
GetChildWindows CLngPtr([B2].Value)
End Sub
Sub Btn3_Click()
Debug.Print SendMessage(CLngPtr(ActiveCell.Value), EM_REPLACESEL, 0&, ByVal "フルパス" & vbCrLf)
End Sub
Rem =================================================================================================================
▼[Btn1_Click]を実行し「TeraPad」を起動してマウスを「TeraPad」のタイトルバーにポイントして[Esc]を押す ↓こんな感じでTeraPadのhWndをゲット
[___]|_____A_____|___B___|_______C________|________D________| [ 1]| |hWnd |WindowText |ClassName | [ 2]|PointWindow| 133134|無題 * - TeraPad|TTeraPadMainForm |
▼[Btn2_Click]を実行して「TeraPad」の子ウインドウを列挙してみる↓
[___]|_____A_____|____B____|_______________C_______________|_________D_________| [ 1]| |hWnd |WindowText |ClassName | [ 2]|PointWindow| 133134|無題 * - TeraPad |TTeraPadMainForm | [ 3]| 1| 5770786|*:\********\TeraPad\usr\******\|TTeraPadIniFilePath| [ 4]| 2| 1117756|*:\********\TeraPad\TeraPad.exe|TTeraPadExeName | [ 5]| 3| 12586572| |TEdit | [ 6]| 4| 13042662| |TToolBar | [ 7]| 5| 3608138| |TEditor | [ 8]| 6| 986324| |TStatusBar |
▼ClassName「TEditor」が編集領域である事は[Btn1_Click]の実行中にも目視できた事だし、 ターゲットとなるハンドルは[B7]セルの値で間違いなさそうだ。
▼[B7]セルをアクティブにして[Btn3_Click]を実行してみると TeraPadに文字列「フルパス」が届いた (実行する度に文字列「フルパス」が届く事も確認できた)
...ていう感じでした。
(参考文献) エディットメッセージの確認 https://www.tokovalue.jp/EditMessage_U.htm [VBA]広域変数を使用せずに、EnumChildWindowsの結果を取得する - Qiita https://qiita.com/nukie_53/items/d4a803080d4c1f3ab35d
（白茶） 2023/06/08(木) 15:58:29
よくよく見返してみたら > ローカルアプリ内のダイアログ ダイアログかぁ... それでメンドイ事になってるのかなぁ...
...などと妄想を膨らませ中。
それに実際にはマウスでポイントしてハンドル探す訳でもないし... ダイアログのルートハンドルから、その下にある目的のEdit系コントロールまでの辿り方を探す必要があるって事ですよね。
てな訳で、引き続きTeraPadを題材にして追加実験してみました。 TeraPadの「オプション」ダイアログの中にある「デフォルトフォルダ」を指定するEditのハンドルを取ってみる。
▼こんなモジュールを準備しておく(改)
Rem ************************************************************************************************************************
Rem 標準モジュール
Rem ************************************************************************************************************************
Option Explicit
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongLong) As LongPtr
#Else
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
#End If
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As Collection) As Long 'ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vkey As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare Function GetAncestor Lib "user32" (ByVal hWnd As LongPtr, ByVal gaFlags As Long) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Rem Window Messages
Private Const WM_SETTEXT = &HC&
Rem Edit Control Messages
Private Const EM_REPLACESEL = &HC2&
Private Const GA_PARENT As Long = &H1 '直接の親ウィンドウ
Private Const GA_ROOT As Long = &H2 '親をたどっていったルート・ウィンドウ
Private Const GA_ROOTOWNER As Long = &H3 'オーナー・ウィンドウのルート・ウィンドウ
Rem =================================================================================================================
Private aCurPos As POINTAPI, sw As Boolean
Rem =================================================================================================================
#If Win64 Then
Private Function PointToLongLong(Point As POINTAPI) As LongLong
Dim ll As LongLong
Dim cbLongLong As LongPtr
cbLongLong = LenB(ll)
If LenB(Point) = cbLongLong Then
CopyMemory ll, Point, cbLongLong
End If
PointToLongLong = ll
End Function
#End If
Rem =================================================================================================================
Property Get PointWindow() As LongPtr
#If Win64 Then
PointWindow = WindowFromPoint(PointToLongLong(aCurPos))
#Else
PointWindow = WindowFromPoint(aCurPos.x, aCurPos.Y)
#End If
End Property
Private Sub Observer()
Dim buff As String
buff = String$(&H20, vbNullChar)
Dim h As LongPtr, s As String
[A1].Value = "監視中..."
[B1:D1].Value = [{"hWnd","WindowText","ClassName"}]
[A2].Value = "PointWindow"
Do While sw
GetCursorPos aCurPos
h = PointWindow
[B2] = h
s = buff
GetWindowText h, s, &H20
[C2] = s
s = buff
GetClassName h, s, &H20
[D2] = s
If GetAsyncKeyState(vbKeyEscape) <> 0 Then sw = False
DoEvents
Sleep &H10&
Loop
[A1].Value = Empty
End Sub
Rem =================================================================================================================
Private Function EnumChildProc(ByVal hWnd As LongPtr, ByVal lParam As Collection) As Boolean
lParam.Add hWnd
EnumChildProc = True
End Function
Sub GetChildWindows(TargethWnd As LongPtr)
Dim c As Collection
Set c = New Collection
Call EnumChildWindows(TargethWnd, AddressOf EnumChildProc, c)
If c.Count = 0 Then Exit Sub
Dim buff As String
buff = String$(&H20, vbNullChar)
Dim i As Long, s As String, t As String
ReDim v(-1 To c.Count, 0 To 6)
v(-1, 1) = "hWnd"
v(-1, 2) = "WindowText"
v(-1, 3) = "ClassName"
v(-1, 4) = "Parent"
v(-1, 5) = "Root"
v(-1, 6) = "RootOwner"
v(0, 0) = "PointWindow"
v(0, 1) = TargethWnd
s = buff
t = s
GetClassName TargethWnd, s, &H20
GetWindowText TargethWnd, t, &H20
v(0, 2) = t
v(0, 3) = s
v(0, 4) = GetAncestor(TargethWnd, GA_PARENT)
v(0, 5) = GetAncestor(TargethWnd, GA_ROOT)
v(0, 6) = GetAncestor(TargethWnd, GA_ROOTOWNER)
For i = 1 To c.Count
s = buff
t = s
GetClassName c(i), s, &H20
GetWindowText c(i), t, &H20
v(i, 0) = i
v(i, 1) = c(i)
v(i, 2) = t
v(i, 3) = s
v(i, 4) = GetAncestor(c(i), GA_PARENT)
v(i, 5) = GetAncestor(c(i), GA_ROOT)
v(i, 6) = GetAncestor(c(i), GA_ROOTOWNER)
Next
Workbooks.Add
With [A1:G3].Resize(c.Count + 2)
.Columns("C:D").NumberFormat = "@"
.Value = v
.EntireColumn.AutoFit
End With
End Sub
Rem =================================================================================================================
Sub Btn1_Click()
sw = Not sw
If sw Then Call Observer
End Sub
Sub Btn2_Click()
If [B2].Value = 0 Then Exit Sub
GetChildWindows CLngPtr([B2].Value)
End Sub
Sub Btn3_Click()
Debug.Print SendMessage(CLngPtr(ActiveCell.Value), EM_REPLACESEL, 0&, ByVal "フルパス" & vbCrLf)
End Sub
Rem =================================================================================================================
▼[Btn1_Click]を実行し「TeraPad」を起動して「オプション」ダイアログを出しておく。 マウスで「オプション」ダイアログのタイトルバーをつかんだ状態で[Esc]を押す。(ポイントだとダイアログ閉じちゃう...[Esc]で orz) ↓こんな感じでダイアログのhWndをゲット
[___]|_____A_____|___B____|____C_____|_____D______| [ 1]| |hWnd |WindowText|ClassName | [ 2]|PointWindow| 1181560|オプション|TOptionForm |
▼[Btn2_Click]を実行してダイアログの子ウインドウを列挙してみる↓
[___]|_____A_____|___B____|_______________C_______________|_______D________|___E____|___F____|____G_____| [ 1]| |hWnd |WindowText |ClassName |Parent |Root |RootOwner | [ 2]|PointWindow| 1181560|オプション |TOptionForm | 65552| 1181560| 2623750| [ 3]| 1| 2361656| |TPanel | 1181560| 1181560| 2623750| [ 4]| 2| 4852022|一時反映(&N) |TButton | 2361656| 1181560| 2623750| [ 5]| 3| 1181532|OK |TButton | 2361656| 1181560| 2623750| [ 6]| 4| 1902216|キャンセル |TButton | 2361656| 1181560| 2623750| [ 7]| 5| 1247186| |TPanel | 1181560| 1181560| 2623750| [ 8]| 6| 1116006| |TPageControl | 1247186| 1181560| 2623750| [ 9]| 7| 1312786|フォルダ |TXPTabSheet | 1116006| 1181560| 2623750| [ 10]| 8| 1181932|デフォルトフォルダ |TXPGroupBox | 1312786| 1181560| 2623750| [ 11]| 9| 1050568|... |TButton | 1181932| 1181560| 2623750| [ 12]| 10| 3082460|D:\Documents |TEdit | 1181932| 1181560| 2623750| [ 13]| 11| 2296066|デフォルトフォルダを指定する(&D|TCheckBox | 1181932| 1181560| 2623750| [ 14]| 12| 1181568|文字コード |TXPTabSheet | 1116006| 1181560| 2623750| [ 15]| 13| 5770290|文字コードの設定 |TXPGroupBox | 1181568| 1181560| 2623750| [ ] (以下省略)
▼[Btn4_Click]を実行して[TEdit]のハンドルまで辿ってみる (FindWindowExは直接の子ウインドウしか見つけられないから、素直に上から順に辿ってってみた)
Sub Btn4_Click()
Dim h As LongPtr, x As LongPtr
h = CLngPtr(ActiveCell.Worksheet.[B2].Value) '<---------------------- h:= 1181560
If h Then x = FindWindowEx(h, 0&, "TPanel", vbNullString) '<--------- x:= 2361656
If h Then h = FindWindowEx(h, x, "TPanel", vbNullString) '<---------- h:= 1247186
If h Then h = FindWindowEx(h, 0&, "TPageControl", vbNullString) '<--- h:= 1116006
If h Then h = FindWindowEx(h, 0&, "TXPTabSheet", vbNullString) '<---- h:= 1312786
If h Then h = FindWindowEx(h, 0&, "TXPGroupBox", vbNullString) '<---- h:= 1181932
If h Then h = FindWindowEx(h, 0&, "TEdit", vbNullString) '<---------- h:= 3082460
Debug.Print h
End Sub
なんとか出来ました。
まあ、VBA勉強中さんのローカルアプリが、同じように辿れるアプリだとは限りませんが、 事例のひとつとして掲載させて頂きます。
（白茶） 2023/06/08(木) 20:27:21
DialogHandle = FindWindow(vbNullString, "ファイルを開く")
Handle = FindWindowEx(DialogHnd, 0&, "ComboBoxEx32", vbNullString)
Handle = FindWindowEx(Handle, 0&, "ComboBox", vbNullString)
Handle = FindWindowEx(Handle, 0&, "Edit", vbNullString)
やはりSendMessageでフルパスが送れないです。
今回はフルパスで送りたいのですが、(1)で送れない原因を
ご存じであれば教えていただきたいです。
（VBA勉強中） 2023/06/12(月) 14:51:17
ByVal 途中パス & ファイル名 で送れるんなら、 ByVal CStr(フルパス) でも送れそうですね。
送れるんなら、変数[フルパス]の型宣言の問題かな? (ただ、それならエラーになってる気もするので... 正直よく分かんないス)
（白茶） 2023/06/12(月) 15:07:03
Private Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
（VBA勉強中） 2023/06/13(火) 12:06:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.