windows7のエクスプローラをVBAで操作

このQ&Aのポイント
  • Excel-VBAで起動しているWindows7のエクスプローラに対してハンドルを取得し、クリックやテキストボックスへの入力を行いたい。
  • WindowsXPでは正常に動作していたが、Windows7でエクスプローラが変わったため、動作しなくなった。
  • ハンドルが取得できず、読み込み専用と表示されている。また、IAccessibleのUUID値が分からず、ボタンクリックや文字列のセットができない。
回答を見る
  • ベストアンサー

windows7のエクスプローラをVBAで操作-3

アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったらエクスプローラが変わったため正しく動作しなくなりました。 やりたいのはエクスプローラに検索文字列(添付ファイル参照)をセットして検索をさせたいのです。 「windows7のエクスプローラをVBAで操作-1」「windows7のエクスプローラをVBAで操作-2」のタイトルで質問させていただき、下のコードを考えましたが、★のところでハンドルが返らず0でした。InspectObjectsで見ると「読み込み専用」と。これが原因ですか?どうしたらいいのだろう・・・。 またこのハンドルを取得して、AccessibleObjectFromWindowでIAccessible を取り出して、accDoDefaultActionしたいのですが、UUIDの値が分かりません。OLEViewで見たのですがExplorer関連がいくつかあり(添付ファイル参照)どれを使っていいものやら。ボタンクリックの後に文字列セットがあるのですが、まだたどり着けず。 IAccessible初心者です。 質問ばかりで済みませんがコーディングのアドバイスお願いします。 Option Explicit Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _ (ByVal hWnd As Long, _ ByVal dwObjectID As Long, _ ByRef riid As Any, _ ByRef ppvObject As Any) As Long Const WM_SETTEXT = &HC '文字列送信 Const BM_CLICK = &HF5 'クリック Const OBJID_CLIENT As Integer = &HFFFFFFFC Private Type UUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private IID_IAccessible As UUID Private oShell Private ie Private hWnd As Long Private SearchBoxハンドル As Long Private Search_Folder As String Private RC As Long 'Private objAcc As IAccessible Private objAcc As UUID Private varChild As Variant Private cnt Private fullnames As String Sub 検索指定のインプット() Search_Folder = "c:\xxx" Set oShell = CreateObject("Shell.Application") For cnt = oShell.Windows().Count - 1 To 0 Step -1 ' On Error Resume Next Set ie = oShell.Windows().Item(cnt) fullnames = ie.FullName ' On Error GoTo 0 If fullnames = "C:\Windows\Explorer.EXE" Then ie.Navigate (Search_Folder) hWnd = FindWindow("CabinetWClass", vbNullString) hWnd = FindWindowEx(hWnd, 0, "WorkerW", vbNullString) hWnd = FindWindowEx(hWnd, 0, "ReBarWindow32", vbNullString) hWnd = FindWindowEx(hWnd, 0, "UniversalSearchBand", vbNullString) hWnd = FindWindowEx(hWnd, 0, "Search Box", vbNullString) hWnd = FindWindowEx(hWnd, 0, "SearchEditBoxWrapperClass", vbNullString) hWnd = FindWindowEx(hWnd, 0, "SearchBox", vbNullString) ' ★--> 0 return SearchBoxハンドル = hWnd hWnd = FindWindowEx(SearchBoxハンドル, 0, "Button", "検索") hWnd = FindWindowEx(SearchBoxハンドル, 0, "SearchEditBox", vbNullString) ' "SearchEditBox" に検索文字列入力の予定だった With IID_IAccessible .Data1 = &H68284FAA .Data2 = &H6A48 .Data3 = &H11D0 .Data4(0) = &H8C .Data4(1) = &H78 .Data4(2) = &H0 .Data4(3) = &HC0 .Data4(4) = &H4F .Data4(5) = &HD9 .Data4(6) = &H18 .Data4(7) = &HB4 End With RC = AccessibleObjectFromWindow(hWnd, OBJID_CLIENT, IID_IAccessible, objAcc) ' 80004005が返る varChild = 2 ' Class="Button", Name="検索"のコントロールをクリックしたいが・・・ ' RC = objAcc.accDoDefaultAction(varChild) ' 書き方が違うみたい・・・ ' Class="SearchEditBox" に検索する文字列を入れたいが・・・ Exit Sub End If Set ie = Nothing Next End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.11

ご報告ありがとうございました。 >2時間かかる検索もあります。 MsgWaitForMultipleObjectsを出した意図はDoEventsだけのループだと負荷が高くなるからなのですが、 使われないなら、Sleep APIぐらいは挟んでおいた方がいいですよ。 >検索したい設計書にはExcel、Word、PDF等があり、 了解です。 >WindowObject 不必要にVariant型を使うと遅くなるので固有型の方がいいのでは。

kootsuki4
質問者

お礼

kumatti1さん コメントありがとうございます。 > 使われないなら、Sleep APIぐらいは挟んでおいた方がいいですよ。 アドバイスありがとうございます、入れときました。 >>WindowObject 不必要にVariant型を使うと遅くなるので固有型の方がいいのでは。 as Object で定義しました。As InternetExplorerは自分的になじみが少ないので。 これでクローズしたいと思います。 いろいろとありがとうございました。感謝!

その他の回答 (10)

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.10

>ネットワーク越しの検索をやっていて、1つの検索はMax2時間くらいで、 >トータルで1昼夜かかっています。 いや、違くてトータルの時間でなくて、一回の検索に時間が掛かるならと言う意味で書きました。 (今更ですが)そもそも、エクスプローラで検索しなくてはいけない状況は不思議な気がします。 FileSystemObjectで遅ければ、Dir関数とかコマンドプロンプトのDirとかAPIのFindFirstFileとか使えばいいのではと。

kootsuki4
質問者

お礼

kumatti1さん いろいろとありがとうございました。 ご提供のコードにNavigate処理を入れて、標準モジュールからCallして一応完了する ことができました。 最後にUserformモジュールに書いたコードを載せています。 一応と言うのは、Navigateしたときに★(2)のie_DocumentCompleteのイベントは2回 発生しますが、SUB検索処理が★(1)のステップまで到達しているときに2回目の ie_DocumentCompleteのイベントを受けることがあり、誤動作してしまうことがあります。 この誤動作を検知したときはNavigateからリトライすることで回避しています。 とは言え、ここまで来れたのはkumatti1さんのおかげです。 ありがとうございました。 >いや、違くてトータルの時間でなくて、一回の検索に時間が掛かるならと言う意味 で書きました。 10秒で終わる検索もありますが、2時間かかる検索もあります。 >(今更ですが)そもそも、エクスプローラで検索しなくてはいけない状況は不思議な 気がします。 仕事で納品されたシステムの設計書から文字列を探したいときに使います。 検索したい設計書にはExcel、Word、PDF等があり、これらは検索できなければなりません。 Excelで言えば、セルの中の文字だけではなく、吹き出しの図形の中の文字列も検索 させたくあります。 エクスプローラの検索ではこれらができますので使用しています。(フリーソフトは使用禁止です) あっ、もしかしてFileSystemObjectとかFindFirstFileでも同様のことができるのかな? Option Explicit Private WithEvents EventHandler As Shell32.ShellFolderViewOC Private WithEvents ie As SHDocVw.InternetExplorer Private Filter_Done_flg As Boolean Private Navigate_Done_flg As Boolean Private Sub EventHandler_EnumDone() Filter_Done_flg = True EventHandler.SetFolderView Nothing End Sub Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant)  ★ (2) If Not EventHandler Is Nothing Then EventHandler.SetFolderView pDisp.Document   End If End Sub Private Sub ie_NavigateComplete2(ByVal pDisp As Object, URL As Variant) Navigate_Done_flg = True End Sub Public Sub 検索処理(WindowObject, 検索フォルダ As String, 検索文字列 As String) Dim doc As IShellFolderViewDual3 Set EventHandler = Nothing Set ie = WindowObject Navigate_Done_flg = False ie.Navigate (検索フォルダ) While ie.Busy Or ie.ReadyState <> 4 DoEvents Wend Do DoEvents Loop Until Navigate_Done_flg = True  Filter_Done_flg = False Set EventHandler = New Shell32.ShellFolderViewOC ★(1) Set doc = ie.Document doc.FilterView 検索文字列 While ie.Busy Or ie.ReadyState <> 4 DoEvents Wend Do DoEvents Loop Until Filter_Done_flg = True Set EventHandler = Nothing Set ie = Nothing End Sub

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.9
  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.8

Microsoft Internet Controlsにも参照設定を行って、UserFormモジュールに貼り付けて、 リンク先の回答通りに直せば期待した動作をします。 フィルタリングに時間が掛かる状況は想像出来ませんが、もしそうならMsgWaitForMultipleObjectsを使うのもありかもしれません。 (再利用性を考慮すると)クラスモジュールもありかもしれませんが、その辺は適宜直してください。

kootsuki4
質問者

お礼

kumatti1さん 回答ありがとうございました。 UserFormモジュールに貼り付けでできました。感謝! kumatti1さんには大変お世話になりました。 > フィルタリングに時間が掛かる状況は想像出来ませんが、 ネットワーク越しの検索をやっていて、1つの検索はMax2時間くらいで、 トータルで1昼夜かかっています。 殆どクローズできる状況ですが、あと1~2日だけ開けさせて置いてください。

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.7
kootsuki4
質問者

お礼

kumatti1 さん、コードの提供ありがとうございました。 余り確認する時間がなかったのですが、コードのすべてを標準モジュールに 貼り付けたところ、以下の2行が赤く反転しました。 こちらExcel2010です。 Private WithEvents d As Shell32.ShellFolderViewOC Private WithEvents ie As SHDocVw.InternetExplorer 一部をクラスモジュール、一部を標準モジュールに置くのでしょうか。 以下の部分をクラスモジュールに置き、Private Sub UserForm_Initialize()以下を 標準モジュールに置くと、dとかieの変数の宣言が足りません。 Option Explicit Public WithEvents d As Shell32.ShellFolderViewOC Public WithEvents ie As SHDocVw.InternetExplorer Private flg As Boolean Private Sub d_EnumDone() flg = True Debug.Print "d_EnumDone" d.SetFolderView Nothing End Sub Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant) d.SetFolderView pDisp.Document End Sub クラスモジュールを使ったことがなく、基本的なところの質問で申し訳ありませんが よろしくお願いします。

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.6

ShellFolderViewOC.EnumDoneイベントですが、タイミングがシビアみたいでこちらではまだ、上手く行ってません。 http://msdn.microsoft.com/en-us/library/windows/desktop/bb774010%28v=vs.85%29.aspx # 参照設定は「Microsoft Shell Controls And Automation」

kootsuki4
質問者

お礼

kumatti1 さん、アドバイスありがとうございます。 > ShellFolderViewOC.EnumDoneイベントですが、タイミングがシビアみたいでこち らではまだ、上手く行ってません。 ExcelVBA側でエクスプローラのイベントをハンドルすること自体から難しそうです ね。 ShellFolderViewOC.EnumDoneno のネット上の例題もあまりありませんでした。 クラスモジュールに書かないといけない・・・? エクスプローラを起動しないといけない・・・? Windows7でテストしたいと思いますので(もしかして問題なく動くかも)コードを お教え戴けないでしょうか。 以上よろしくお願いします。

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.5

Win.document.FilterView "hoge" の一文で済む様です。 IShellFolderViewDual3::FilterView method http://msdn.microsoft.com/en-us/library/windows/desktop/bb761289%28v=vs.85%29.aspx

kootsuki4
質問者

お礼

kumatti1さん、驚きの回答ありがとうございます。 >Win.document.FilterView "hoge" >の一文で済む様です。 と、あったので「何が一文で済むのか」分からないまま動かしてみると 検索文字列として hoge が入るじゃないですか。 びっくりしました。 ありがとうございました。 もう自分のスキルが届くところではないですね。 最後にもうひとつアドバイス戴けたらと思います。 検索させる部分と検索結果を取り出す部分の骨格は以下のようになりましたが、 検索が終わったことをどのようにして判断するかが分かっておりません。   (Sleep 10000 の部分) 定期的に検索結果を取得するとしても、終了を表す文字列も無さそうですし・・・。 何かのプロパティがあれば嬉しいのですが。 長い間お付き合いして戴き申し訳ありませんがよろしくお願いします。 Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Sub 検索() Dim Win As Object Dim Search_Folder As String Dim Oshell As Object Dim Gyo As Long Dim Col As Long Dim hWnd As Long Dim Works As String Dim Folder As Object Dim Folderitem As Object Dim Folder_title As String Set Oshell = CreateObject("Shell.Application") Set Win = Nothing For Each Win In Oshell.Windows() If Win.FullName = "C:\Windows\Explorer.EXE" Then Exit For End If Set Win = Nothing Next If Win Is Nothing Then Exit Sub ThisWorkbook.Sheets("sheet1").Cells.ClearContents Win.Navigate ("c:\xxx") Sleep 500 Win.document.FilterView "検索文字列" Sleep 10000 ' ここで検索終了を待ちたい ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value = "結果なし" Set Folder = Win.document.Folder On Error Resume Next Folder_title = Folder.Items().Item().Path On Error GoTo 0 If Left(Folder_title, 4) = "検索場所" Then If Folder.Items().Count <> 0 Then Gyo = 1 For Each Folderitem In Folder.Items() For Col = 0 To 7 ThisWorkbook.Sheets("sheet1").Cells(Gyo, Col + 1).Value = Folder.GetDetailsOf(Folderitem, Col) Next Gyo = Gyo + 1 Next End If End If End Sub

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.4

こちらはWin8.1ですが、ここは >hWnd = FindWindowEx(hWnd, 0, "SearchBox", vbNullString) ' ★--> 0 return DirectUIHWND になってますね。

kootsuki4
質問者

お礼

ありがとうございます。 Windows7ですが、hWnd = FindWindowEx(hWnd, 0, "DirectUIHWND", vbNullString) でハンドルが確かに返ってきました。 InspectObjectsで見るとClass="SearchBox"なのですが、Classが"DirectUIHWND"みたいな文言もあります。 よく分かりません。

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.3

こちらでも確認したところ、Application.SendKeysでなくて、SendKeysなら 漢字文字列 もセット出来ました。 https://gist.github.com/kumatti1/9b6eac43e294db94e837 >UUID(IAccessible?)の値 継承関係のあるインターフェースIDならOKです。 IAccessible以外には IDispatch とか IUnknown とか。 --- Visual Studio評価版は3ヶ月利用できるようなので、C++を入れればSpy++も入るのでそちらからも確認されるとか。 IAccessibleの他にUI Automationてのもありますよ。

  • kumatti1
  • ベストアンサー率60% (73/121)
回答No.2

アドレスバーと同じ理屈でクリックさせてからでないと無理なのかも。 (調査用と言うわけでもないが)AccessibleObjectFromPointとかもありますよ。 hwndプロパティでハンドルが得られるので、「Ctrl + F」相当のキー送信をWM_KEYDOWN辺りで送れば、検索ボックスにフォーカスされるので、 (他プロセスであっても)AttachThreadInputでGetFocus(APIの方)でハンドルが得られるのでWM_SETTEXTやらWM_CHARを送信するとか。で確定はWM_KEYDOWNでVK_RETURNとか。 ↓コメントアウトしてる方が正しいです。 'Private objAcc As IAccessible Private objAcc As UUID >Const OBJID_CLIENT As Integer = &HFFFFFFFC Long型 --- ただ、この辺を見るとIUnknown_QueryService(提示のコードで言えば引数にieを指定)で IFolderView2インターフェースを得て制御するのが本来の実装なんでしょうね。 まあでもVBA向けのタイプライブラリがありませんので、C++でDLLを作ってVBAから呼び出すとかになるのかなと。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1496271564 http://www.activebasic.com/forum/viewtopic.php?t=1828

kootsuki4
質問者

補足

kumatti1さん 引き続きアドバイスありがとうございます。 >アドレスバーと同じ理屈でクリックさせてからでないと無理なのかも。 上位の"Search Box"のハンドルと "SearchEditBoxWrapperClass"のハンドルに対して SendMessage(hWnd, BM_CLICK, 0, 0)を実行してみましたが、やはり結果は同じで "SearchBox",のハンドルは取得できませんでした。 >(調査用と言うわけでもないが)AccessibleObjectFromPointとかもありますよ。 あるポイントのAccessibleObjectを取得できるみたいですね。まだ試しておりません。 >「Ctrl + F」相当のキー送信をWM_KEYDOWN辺りで送れば、検索ボックスにフォーカスされるので、 Navigateしたあとに、以下のコードを実行したら検索文字列"ABC"は入りました。 AppActivate ("xxx") ・・・検索フォルダの最下位のフォルダ名 Sleep 1000 Application.SendKeys "^f" Sleep 1000 Application.SendKeys "abc" しかし、漢字文字列を検索したいので、やはり"SearchEditBox"に対して文字を入れないとダメかなと思っています。またSendKeysは動作時点にフォーカスされているところにSendkeyされるので操作の制約ができてしまうかなと思っています。 と言うことで、 IAccessibleの攻略が必須のようです。 まだ分かっていないのですが、今回場合、UUID(IAccessible?)の値には何を与えるのでしょうか? OLEViewで見たのですがExplorer関連がいくつかありました(添付ファイル参照)。 Explorer Browser、Explorer Browser Results Folder、Explorer Navigation Bar、 Explorer Search Band、Explorer Travel Band、ExplorerCommandEnumeratorのどれ かとは思うのですが・・・。DLL名から推測するとか・・・? 試しにExplorerBrowserを展開するとIAccssibleObjectと言う如何にもそれっぽいものもあります。表示されるInterface=に続く数字がUUIDなのかな?どなたか教えて戴ければ有難いです。 また、よろしくお願いします。

回答No.1

If fullnames = "C:\Windows\Explorer.EXE" Then internetExplorer じゃないの? あと、参照設定がどうなってるか

kootsuki4
質問者

お礼

2014itochanさん アドバイスありがとうございました。 >internetExplorer じゃないの?   変数名をIEとしていたのが紛らわしかったですね。   Explorerです >あと、参照設定がどうなってるか 参照設定は次のようになっていました。   Visual Basic For Applications   Microsoft Excel 14.0 Object Library   OLE Automation   Microsoft Office 14.0 Object Library またよろしくお願いします。

関連するQ&A

  • windows7のエクスプローラをVBAで操作-1

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラの現在のフォルダパスが表示されるところに(添付ファイル参照)文字を入れるものです。 最後のSendMessageAnyで1が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。 なおハンドルの値はSDKのInspect Objectsで確認していますので、正しく取得できていると思っています。 よろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) 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 Const WM_SETTEXT = &HC Private hwnd As Long Private FOLDER As String Sub Put_folder_name1() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) FOLDER = "\\xx.xx.xx.xx\test" RC = SendMessageAny(hwnd, WM_SETTEXT, 0, ByVal FOLDER) end sub

  • windows7のエクスプローラをVBAで操作-2

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラのフォルダパスの右のボタン(添付ファイル参照)をクリックすべく、コーディングしたものです。 最後のSendMessage(hwnd, BM_CLICK, 0, 0) でクリックしたいのですが、その前にボタンのハンドルが取得できません。SDKのInspect Objectsで調べると、このボタンはClass="ToolbarWindow32"でName="前の場所"ですが、NativeWindowHandleが表示されず、Legacy.IAccessible.ChildID=1となっています。 このようなウィンドゥは別のやり方(IAccessible?)でないとクリックできないように感じていますが如何せん知識がありません。 どうしたらできるか、アドバイスよろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long Const BM_CLICK = &HF5 Private hwnd As Long Sub Click_button() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ToolbarWindow32", vbNullString) ' この次が分からない。 RC = SendMessage(hwnd, BM_CLICK, 0, 0) end sub

  • VB.netでFindWindowExやると・・・9222812402616107008!?

    VB.netでWin32APIのFindWindowExを使うと, たとえばスタートボタンのHWNDを拾ってくるとき, 本当なら65662(6.0のSpy++で確認+10進変換)が返ってきて欲しいんですが, 9222812402616107008という,異常な数が返ってきます. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpsz1 As String, <MarshalAs(UnmanagedType.LPTStr)> ByVal lpsz2 As String) As Long とやってあります. VB6.0のAPIビューワからコピペして,MarshalAsをつけてみました.   (初心者なので,わけわからないまま付けましたけど; hWnd_ShellTrayWnd = FindWindowEx(0,0,"Shell_TrayWnd",vbNullString) hWnd_StartButton = FindWindowEx(hwnd_ShellTrayWnd,0,"Button",vbNullString) とやってるのですが・・・. 不思議なのは,hWnd_ShellTrayWndが9222812402616238204になっているにもかかわらず,次のFindWindowExで,hWnd_StartBtnが9222812402616107008になってるところです・・・. しかも,ありえないクラス名(KeyBoadぐちゃぐちゃ押し)を指定しても,なぜか数が返ってくるんです. FindWindowExを成功させる(きちんとした数を取る)方法,またはFindWindowEx以外でhWndを拾ってくる方法,ありましたら,教えてください.

  • VBAでSetTextColorがうまくいかない

    EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------

  • WinAPIで電卓をクリック

    現在、WinAPIを勉強しており、練習としてVBAを用いて、電卓アプリのボタンをクリックしようとしています。 キーを送るのではなく、クリックで行いたいたいと 考えています。 ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックできず、EditBoxに数字が 入りません。 どのようにすればよいのかご教授ください。 よろしくお願い致します。 環境: WinXP home、 Excel2002、Win付属アプリの電卓v5.1 ---作成したプログラム---- '標準モジュールの中身 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Sub Main() Dim lngWindWnd As Long 'ウィンドウハンドル Dim ret As Long Dim hCalc As Long 'アプリケーションタイトルより、ウィンドウハンドルを得ます lngWindWnd = FindWindow(vbNullString, "電卓") '8ボタンのハンドル(確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub

  • VBAでIEの「ファイルのダウンロード」ダイアログを制御

    VBではなくVBAにて、IEの「ファイルのダウンロード」ダイアログを制御したいと思い、過去の同様の質問等を参考に下記のソースを作成して動かしてみましたが、「ファイルのダウンロード」画面で、「保存(S)」ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックができず、次に進むことが出来ませんでした。 手動で「保存(S)」ボタンを押下して、強制的に「名前を付けて保存」画面に遷移させた後プログラムを再開すると、同画面の「保存(S)」ボタンのクリックはできました。 同じロジックで「名前を付けて保存」画面の「保存(S)」は動くのに、「ファイルのダウンロード」画面の「保存(S)」が動かないのはなぜでしょうか。 どなたかおわかりになる方がいらっしゃいましたら、ご回答をお願いします。 ***使用環境*** OS: XP pro IE: 6 OFFICE:2002 ***以下作成したソース(エラー制御は省略)*** Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Sub Test() Dim ret1 As Long Dim ret2 As Long Const WM_COMMAND As Long = &H111 ret1 = FindWindow("#32770", "ファイルのダウンロード") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) ret1 = FindWindow("#32770", "名前を付けて保存") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) End Sub ***以上ソース終わり***

  • アクセス2010VBA側から他のプログラムを操作

    アクセス2010VBA側から他のプログラムを操作したくて実験しています。 標準モジュールに Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long としておき、 フォーム側に下記のコードを書いています。 Dim tw, tt As Long tw = FindWindow(vbNullString, "電卓") If tw <> 0 Then tt = FindWindowEx(tw, 0&, "5", "") If tt <> 0 Then beep End If FindWindowは取れるのですが、tt = FindWindowExが「0」で取れません。 どこに不具合があるのでしょうか? 将来的に、SendMessage(tw, ~~~)として他プログラムを制御したいのですが、 アクセス2010で可能でしょうか? http://mukkumuku.blogspot.jp/2010/11/office2010-win32api-findwindowfindwindo.html も参考にしましたが、やはり「0」しか返ってきません。

  • VBA ユーザーフォームの×ボタン制御の不具合

    PowerPoint VBAで複数のユーザーフォームからなるVBAマクロを作成しました。 フォーム内の「次へ」「前へ」ボタンでのみ、マクロの実行制御をしているので、途中で右上の×を押されると、想定外エラーが発生します。 そこで、一番下に貼りつけたようなコードを全てのフォームに挿入することで、右上の×が表示されないようにしました。 あくまでフォームにしかコードは埋め込んでいません。 (標準モジュール、クラスには入ってません) ですが、極稀に、「フォームの右上×」ではなく、「PowerPointの右上×」が非表示になってしまう現象が発生します。 いろいろやるうちに再現はするのですが、厳密な再現手順がよくわかりません。 状況と下記ソースから、どこらへんに原因がありそうかアドバイス頂けないでしょうか? 全コードは出せない部分が多いのですが、アドバイスにあたり必要なコードがあれば、別途貼らせて頂きます。 Private Const GWL_STYLE = (-16) Private Const WS_SYSMENU = &H80000 ' ウィンドウに関する情報を返す Private Declare Function GetWindowLong Lib "USER32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long ' ウィンドウの属性を変更 Private Declare Function SetWindowLong Lib "USER32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long ' Activeなウィンドウのハンドルを取得 Private Declare Function GetActiveWindow Lib "USER32.dll" () As Long ' メニューバーを再描画 Private Declare Function DrawMenuBar Lib "USER32.dll" (ByVal hWnd As Long) As Long ' フォームアクティブ時処理 Private Sub UserForm_Activate() Dim hWnd As Long Dim Wnd_STYLE As Long hWnd = GetActiveWindow() Wnd_STYLE = GetWindowLong(hWnd, GWL_STYLE) Wnd_STYLE = Wnd_STYLE And (Not WS_SYSMENU) SetWindowLong hWnd, GWL_STYLE, Wnd_STYLE DrawMenuBar hWnd End Sub

  • Accessible ObjからIE Obj

    VBAからIE9のタブ機能を操作しようと悪戦苦闘しております。 詳しく申し上げると、最前面に表示されているIEの アクティブなタブを確実につかんだうえで、 そのページのDOMを操作したいです。 色々調べていったところ、IAccessibleインタフェースの 中にあるaccStateプロパティを見れば、タブがアクティブになっているかどうか 判別できるところまでたどり着きました。 以下のページを参考にしました。 http://mt-soft.sakura.ne.jp/kyozai/excel_apps/tab-ctrl/index-jump.html?pg_02.html ※C#を多少かじったので、クラス等の知識は微量ですがあります。 上記のサイトを参考に実際にコードを組んでいたのですが、 AccessibleオブジェクトとIEオブジェクトを行き来する方法が わからず、せっかくタブの状態がわかっても それをメインのコードに反映することができません。 Accessibleオブジェクトの階層を上のほうまで辿って行けば、 IEオブジェクト(Shell Windowオブジェクト?)にたどり着く? ということも考えたのですが、辿り方がわからず頓挫しております。 最前面のIEはFindWindow関数でハンドルを取得し、 それをAccessibleインターフェイスに渡す方法で accStateを取得しています。 Sub ie_find() Dim IE As Object Dim hWnd As Double hWnd = FindWindow("IEFrame", vbNullString) 'タブのリスト Dim TabList() 'タブリスト作成 MakeTabList hWnd, TabList For i = 0 To UBound(TabList) If TabList(i).accState(CHILDID_SELF) = 2097154 Then Next i ’ここにいれる処理がわかりません。 ’IEオブジェクト⇔Accessibleオブジェクトの ’方法があれば処理できると思います。 End Sub Private Sub MakeTabList(hWnd As Double, ByRef TabList()) ' ' タブ一覧生成 ' Dim hWndChild As Long Dim Cnt As Long, i As Long Dim ClassName As String Call Class_Initialize 'AccessibleオブジェクトのUUID設定 hWndChild = GetDirectUIHWND(hWnd, "CommandBarClass") 'IE9以前 If hWndChild = 0 Then hWndChild = GetDirectUIHWND(hWnd, "WorkerW") 'IE10以降 If hWndChild = 0 Then Exit Sub Dim objAcc As IAccessible, v AccessibleObjectFromWindow hWndChild, OBJID_CLIENT, IID_IAccessible, objAcc If Not (objAcc Is Nothing) Then Dim Children() As Variant Dim Count1 As Long, Count2 As Long Dim retCount As Long Count1 = objAcc.accChildCount ReDim Children(Count1 - 1) Call AccessibleChildren(objAcc, 0, Count1, Children(0), retCount) '子オブジェクト For i = 0 To objAcc.accChildCount - 1 If TypeOf Children(i) Is IAccessible Then If Children(i).accRole(CHILDID_SELF) = ROLE_SYSTEM_PAGETABLIST Then 'タブ行? Count2 = Children(i).accChildCount ReDim TabList(Count2 - 1) 'タブの一覧を生成 「タブ」と「新しいタブ」のボタン Call AccessibleChildren(Children(i), 0&, ByVal Count2, TabList(0), retCount) Exit For End If End If Next i End If End Sub Private Function GetDirectUIHWND(hWnd As Double, ClassName As String) As Long ' ' DirectUIHWND のウィンドウハンドルを取得 ' Dim hWndChild As Long hWndChild = FindWindowEx(hWnd, 0, ClassName, vbNullString) If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "ReBarWindow32", vbNullString) If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "TabBandClass", vbNullString) If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "DirectUIHWND", vbNullString) GetDirectUIHWND = hWndChild End Function Private Sub Class_Initialize() 'AccessibleオブジェクトのUUID設定 With IID_IAccessible .Data1 = &H618736E0 .Data2 = &H3C3D .Data3 = &H11CF .Data4(0) = &H81 .Data4(1) = &HC .Data4(2) = &H0 .Data4(3) = &HAA .Data4(4) = &H0 .Data4(5) = &H38 .Data4(6) = &H9B .Data4(7) = &H71 End With End Sub どうかこの辺詳しい方、ご教示よろしくお願いいたします。

  • SendMessageによるチェックボックスの状態取得

    はじめまして、VB.NET2005でチェックボックスの状態の取得、設定をうまく設定できません。OSはxpです。 Public Class Form1 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"  (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Integer Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Integer, _ ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, _ ByVal wMsg As Integer, ByVal wParam As Integer, ByVal iParam As String) As Integer Private Declare Function SendMessageint Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, _ ByVal wMsg As Integer, ByVal wParam As Integer, ByVal iParam As Integer) As Integer Const BM_GETCHECK = &HF0 Const BM_GETSTATE = &HF2 Const BM_SETCHECK = &HF1 Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim hWindows As Integer Dim ipEDIT As Integer Dim i As Integer hWindows = FindWindow(vbNullString, "Form1") '198458 ipEDIT = FindWindowEx(hWindows, 0, vbNullString, "CheckBox1") MessageBox.Show(ipEDIT) i = SendMessageint(ipEDIT, BM_GETCHECK, 0, 0) 'SendMessageint(ipEDIT, BM_SETCHECK, 1, 0) MessageBox.Show(i) End Sub End Class のようなコードなのですが、 ハンドルは取得できているのですが、 SendMessageの戻り値は0になります。 勿論、コメントのチェックをセットも出来ません。 ご教授のほど宜しくお願いします。

専門家に質問してみよう