[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『メモ帳内容の全範囲を選択しクリップボード格納(API使用)』（のらじろう）
こんにちは、よろしくお願いいたします。
↓の質問の続きのような質問です。 [[20150326105138]] 『開いているメモ帳(複数)の選択範囲の文字列を取得』（のらじろう）
先日の質問のコードを少し変えて開いているメモ帳の全範囲を選択して新規テキストファイル保存、という コードを作成中です。
なるべくSendKeysを使わないように変えてみました。 途中まではうまくいっているのですが、コードの末尾に★を付けている部分がうまくいきません。
「WM_COMMAND」で25を与えてメモ帳の全範囲を選択し、その次に「WM_COPY」で選択範囲をコピー しクリップボードに格納する、という部分です。 全範囲選択はうまくいってます。その次のコピーする、という部分がうまくいきません。 エラーにはならないのですが、クリップボードには何も格納されません。
どのように変えたらいいでしょうか？ ヒントや参考HPでも構いません。ご教示いただきましたら幸いです。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long _
) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function EnumWindows Lib "user32.dll" ( _
ByVal lpEnumFunc As Long, _
lParam As Long _
) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function OpenClipboard Lib "user32" _
(ByVal hWndNewOwner As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Const WM_QUIT As Long = &H12 Const WM_COMMAND As Long = &H111 Const WM_COPY As Long = &H301 Const WM_COPYDATA As Long = &H4A
Dim CB As New DataObject Dim ary() As Variant Dim cnt As Integer
Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long Dim mycls As String Dim StrCls As String Dim StrCap As String
StrCap = String(255, Chr(0)) Call GetWindowText(hWnd, StrCap, Len(StrCap))
StrCls = String(50, Chr(0)) Call GetClassName(hWnd, StrCls, Len(StrCls))
mycls = Left(StrCls, InStr(1, StrCls, Chr(0)) - 1)
If mycls = "Notepad" Then
cnt = cnt + 1
ReDim Preserve ary(1, cnt)
ary(0, cnt) = hWnd
ary(1, cnt) = Left(StrCap, InStr(1, StrCap, Chr(0)) - 1)
End If
EnumWindowsProc = 1
End Function
Sub SampleEnumWindows()
Dim myhwnd As Long
Dim i As Integer
Dim txtpath As String
Dim genzai As String
Dim ernum As Long
Dim cbstr As String
Dim cntb As Integer
Dim selstrary() As Variant
Dim folpath As String
ernum = -2147221404
genzai = Format(Now, "yymmdd_hhmmss")
folpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & genzai
cnt = -1
Call EnumWindows(AddressOf EnumWindowsProc, 0)
If cnt <> -1 Then
cntb = -1
For i = 0 To cnt
myhwnd = ary(0, i)
Call cbclr
Call SetForegroundWindow(myhwnd)
Sleep 50
Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
Sleep 100
'Call SendMessage(myhwnd, WM_COPYDAT, 0, 0) 'ここは今回は使ってません
Call SendMessage(myhwnd, WM_COPY, 0, 0) '★
Sleep 100
Err.Clear
cbstr = ""
With CB
On Error Resume Next
.GetFromClipboard
cbstr = .GetText
'MsgBox cbstr
End With
If Err.Number = ernum Then
Else
cntb = cntb + 1
If cntb = 0 Then MkDir (folpath)
ReDim Preserve selstrary(1, cntb)
selstrary(0, cntb) = cbstr
selstrary(1, cntb) = ary(1, i)
End If
Call PostMessage(myhwnd, WM_QUIT, 0, 0)
On Error GoTo 0
Next i
If cntb <> -1 Then
For i = 0 To cntb
txtpath = folpath & "\" & genzai & "_" & Format(i, "00") & "_" & selstrary(1, i) & ".txt"
Call TxtOutput(txtpath, CStr(selstrary(0, i)))
Next i
End If
If cntb <> -1 Then Erase selstrary
End If
If cnt <> -1 Then Erase ary
Call cbclr
End Sub
Function cbclr()
If OpenClipboard(0) Then
EmptyClipboard
CloseClipboard
End If
End Function
Function TxtOutput(ByVal newtxtpath As String, newtxtstr As String) Dim fnum As Integer fnum = FreeFile Open newtxtpath For Output As #fnum Print #fnum, newtxtstr; Close fnum End Function
＜ 使用 Excel：unknown、使用 OS：WindowsVista ＞
↓のように追加、変更することでうまくいきました。お騒がせしました。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'○追加
Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long _
) As Long
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long _
) As Long
Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function IsWindowEnabled Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function EnumWindows Lib "user32.dll" ( _
ByVal lpEnumFunc As Long, _
lParam As Long _
) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
'Declare Function SendMessageAny Lib "user32.dll" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) As Long
Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function OpenClipboard Lib "user32" _
(ByVal hWndNewOwner As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Const WM_QUIT As Long = &H12 Const WM_COMMAND As Long = &H111 Const WM_COPY As Long = &H301 Const WM_COPYDATA As Long = &H4A
Dim CB As New DataObject Dim ary() As Variant Dim cnt As Integer
Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long Dim mycls As String Dim StrCls As String Dim StrCap As String
StrCap = String(255, Chr(0)) Call GetWindowText(hWnd, StrCap, Len(StrCap))
StrCls = String(50, Chr(0)) Call GetClassName(hWnd, StrCls, Len(StrCls))
mycls = Left(StrCls, InStr(1, StrCls, Chr(0)) - 1)
If mycls = "Notepad" Then
cnt = cnt + 1
ReDim Preserve ary(1, cnt)
ary(0, cnt) = hWnd
ary(1, cnt) = Left(StrCap, InStr(1, StrCap, Chr(0)) - 1)
End If
EnumWindowsProc = 1
End Function
Sub SampleEnumWindows()
Dim myhwnd As Long
Dim lnghWndTarget As Long '○追加
Dim i As Integer
Dim txtpath As String
Dim genzai As String
Dim ernum As Long
Dim cbstr As String
Dim cntb As Integer
Dim selstrary() As Variant
Dim folpath As String
ernum = -2147221404
genzai = Format(Now, "yymmdd_hhmmss")
folpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & genzai
cnt = -1
Call EnumWindows(AddressOf EnumWindowsProc, 0)
If cnt <> -1 Then
cntb = -1
For i = 0 To cnt
myhwnd = ary(0, i)
Call cbclr
Call SetForegroundWindow(myhwnd)
Sleep 50
Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
Sleep 50
lnghWndTarget = FindWindowEx(myhwnd, 0, "Edit", "") '子ウィンドウのEdit '○追加
Call SendMessage(lnghWndTarget, WM_COPY, 0, 0) '★変更
Sleep 50
Err.Clear
cbstr = ""
With CB
On Error Resume Next
.GetFromClipboard
cbstr = .GetText
'MsgBox cbstr
End With
If Err.Number = ernum Then
Else
cntb = cntb + 1
If cntb = 0 Then MkDir (folpath)
ReDim Preserve selstrary(1, cntb)
selstrary(0, cntb) = cbstr
selstrary(1, cntb) = ary(1, i)
End If
Call PostMessage(myhwnd, WM_QUIT, 0, 0)
On Error GoTo 0
Next i
If cntb <> -1 Then
For i = 0 To cntb
txtpath = folpath & "\" & genzai & "_" & Format(i, "00") & "_" & selstrary(1, i) & ".txt"
Call TxtOutput(txtpath, CStr(selstrary(0, i)))
Next i
End If
If cntb <> -1 Then Erase selstrary
End If
If cnt <> -1 Then Erase ary
Call cbclr
End Sub
Function cbclr()
If OpenClipboard(0) Then
EmptyClipboard
CloseClipboard
End If
End Function
Function TxtOutput(ByVal newtxtpath As String, newtxtstr As String) Dim fnum As Integer fnum = FreeFile Open newtxtpath For Output As #fnum Print #fnum, newtxtstr; Close fnum End Function （のらじろう） 2015/05/17(日) 22:29
教えてください。
メモ帳でテキストファイルを３つ開いておき、それぞれ、コピーしたい部分をマウスで選択した上で アップされた改訂版コードを実行しましたら、デスクトップにできたフォルダに、３つのテキストファイルと全く同じ内容のものが ３つコピーされていただけでした。
なにか、操作を間違えているのでしょうか？
（β） 2015/05/18(月) 08:41
βさん、レスありがとうございます。
今回のコードは Call PostMessage(myhwnd, WM_COMMAND, 25, 0) でメモ帳の全範囲を選択状態にしております。
ですので、コピー元のメモ帳と同じ内容が新しいメモ帳 に転記されます。 （のらじろう） 2015/05/18(月) 08:52
追記です。 Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
は、
Application.SendKeys "^A"
と同じ動きになります。 （のらじろう） 2015/05/18(月) 09:05
>Call PostMessage(myhwnd, WM_COMMAND, 25, 0)
この部分を削除して実行したら、前回と同じく選択範囲のみが 転記の対象になります。 （のらじろう） 2015/05/18(月) 09:20
>>メモ帳の全範囲を選択し、その次に「WM_COPY」で選択範囲をコピーしクリップボードに格納する
失礼しました。ここを読み飛ばしておりまして、前回と同じ要件を別方法で処理されたのかなと（コードも読まずに）早とちりしました。
（β） 2015/05/18(月) 12:54
今回の質問のコードに前回の質問時のコードからの変更点を書き込まなかったため 誤解を招くような書き方になってしまいました。
いまAPIでいろいろ情報を取得したりウィンドウを制御したりするのを勉強中です。 また質問させていただくことがあると思います。 その時はまたよろしくお願いいたします。 （のらじろう） 2015/05/18(月) 19:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.