締切済み

EXCELVBA フォルダ検索API

2009/04/25 13:30

エクセルからVBAでフォルダを選択させるコマンドを、APIを使ってフォルダ検索ダイアログボックスを出すまでは見よう見真似でできるのですが、このとき「あたらしいフォルダ」のボタンは必要ないので出したくないのですが、どこかに定数を指定すればよろしいかご存知でしたら教えてください。 (使用OS： Windows2000,Excel：2003) ちなみにコピペした宣言部分は以下のものです。 *************** Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA = (WM_USER + 102) Public Const BFFM_INITIALIZED = 1 ********************

jijii_1988
お礼率100% (2/2)

オフィス系ソフト
回答数2
ありがとう数2

みんなの回答 （2）
専門家の回答

みんなの回答

DOUGLAS_
ベストアンサー率74% (397/534)

2009/04/25 17:56 回答No.2

＞OFFICETANAKAさんの方法にある「2.shellを使う方法」にあるような選択したフォルダがテキストボックスに表示されるようにするAPIでの設定はないでしょうか？に対してのお答えは＞&H10で上に窓がでていました。でよろしいでしょうか？　他にも、「選択したフォルダがテキストボックスに表示される」定数があるようですが、前回答の「●BROWSEINFO のページの [メンバ] - [ulFlags] の項」をよくお読みいただき、お望みの数字に変えてお試しください。　ちなみに、もうお分かりでしょうが、 0x0001：&H1 0x0002：&H2 0x0004：&H4 0x0008：&H8 0x0010：&H10 0x0020：&H20 0x0040：&H40 0x0050：&H50 0x0080：&H80 0x0100：&H100 0x0200：&H200 0x0400：&H400 0x1000：&H1000 0x2000：&H2000 0x4000：&H4000 0x8000：&H8000 です。

質問者

お礼 2009/04/25 19:04

重ね重ねご回答ありがとうございました。またよろしくお願いします。

DOUGLAS_
ベストアンサー率74% (397/534)

2009/04/25 14:48 回答No.1

＞「あたらしいフォルダ」のボタンは必要ないので出したくない　お示しのコードは、 ●フォルダを選択するダイアログ http://officetanaka.net/excel/vba/tips/tips39.htm からコピペされたのでしょうか？　お示しのコードは、上記ページの「4.APIを使う方法(2)」のものと一緒ですが、その上の「3.APIを使う方法(1)」の例図には、[新しいフォルダの作成(M)] が表示されていません。＞どこかに定数を指定すればよろしいか　上記、「3.APIを使う方法(1)」と「4.APIを使う方法(2)」のコードをつぶさに比較してみると、 .ulFlags がその関連だと判ります。つまり、「3.APIを使う方法(1)」の場合は、 .ulFlags = &H1 「4.APIを使う方法(2)」の場合は、 .ulFlags = &H40 となっています。　ここの設定値につきましては、下記をご参考になさってください。 ●BROWSEINFO http://yokohama.cool.ne.jp/chokuto/urawaza/struct/BROWSEINFO.html のページの [メンバ] - [ulFlags] の項です。

質問者

お礼 2009/04/25 16:31

早速、ありがとうございました。こんなことだったのですね。早速&H＊＊を適当変えて試してみました。（どれもあまり変わらないような気がしました）ご親切に甘え、もう1点。 OFFICETANAKAさんの方法にある「2.shellを使う方法」にあるような選択したフォルダがテキストボックスに表示されるようにするAPIでの設定はないでしょうか？

質問者

補足 2009/04/25 16:36

すみません質問者です。 &H10で上に窓がでていました。

関連するQ&A

64ビットエクセルでのAPI宣言/PtrSafe
エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。ところが、64bitのエクセルでは動かないことがわかりました。表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open()　を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。どう直せば良いのでしょうか？全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。
- ベストアンサー
- Excel（エクセル）
ExcelVBAで他のアプリをスクロールさせたい
エクセルVBAから他のアプリのスクロールバーを操作して、指定範囲で画面スクロールしたいと思っています。キー入力では操作出来ない（マウス操作でのみスクロールされる）アプリなので、 Sendkeysは使えないのではないかと思い、 APIでハンドルを取得して、 SendMessageすればできるかなと思いましたが、APIについてよく分からないので、とりあえず、メモ帳で以下を作成してみました。しかし、スクロールされません。どこがいけないのか教えていただけないでしょうか？よろしくお願いします。＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ Public Declare Function FindWindowA Lib "User32" (ByVal cnm As String, ByVal cap As String) As Long Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const WM_VSCROLL = &H115 Public Const WM_HSCROLL = &H114 Public Const SB_TOP　= &H6& Public Const SB_BOTTOM　= &H7& Sub handle_get() 　Dim Handle As Long 　Dim Ap1 As String 　Ap1 = "a.txt - メモ帳" 　AppActivate Ap1 　Handle = FindWindowA(vbNullString, Ap1) 　SendMessage Handle, WM_VSCROLL, SB_BOTTOM, ByVal CLng(0) 　SendMessage Handle, WM_HSCROLL, SB_TOP, ByVal CLng(0) End Sub ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
- ベストアンサー
- その他（プログラミング・開発）
ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード
Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。作ったプログラムは以下の通りです。標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。
- ベストアンサー
- Visual Basic
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, "電卓") '８ボタンのハンドル（確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub
- ベストアンサー
- Visual Basic
APIって
VBで簡単なプログラムを作成しています。 APIも便利なのでサンプルを見ながら使っていますがふと疑問に思ったので教えて下さい。以下の"advapi32.dll"と"ADVAPI32"の違いは何なのでしょうか。大文字、小文字の違いだけで同じなのですか？ dllを省略すると引数に＆をつけるつけないの違いが出るのでしょうか？ 'レジストリの値を取得する Public Declare Function RegQueryValueExstr Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpValueName$, ByVal lpReserved&, ByVal lpType&, ByVal lpData$, lpcbData&) As Long 'レジストリの値を設定する Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Any, ByVal cbData As Long) As Long ネット上にたくさんサンプルはあるので、やりたいことの方法を調べてできればＯＫといったやり方です。きちんと勉強したい気持ちもありますので、参考書籍等紹介して頂いてもうれしいです。
- ベストアンサー
- Visual Basic
APIを使う時は参照設定は不要？
例えば Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub test() Dim Handle As Long Handle = FindWindow("IEFrame", vbNullString) Debug.Print Handle End Sub と言うコードでウィンドウハンドルを取得する場合、参照設定のどこにもチェックを入れませんが、なぜ参照設定しなくても使えるのでしょうか？ Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long が参照設定の代わりになるのですか？
- ベストアンサー
- オフィス系ソフト
windows7のエクスプローラをVBAで操作－１
アドバイスをお願いします。 Excel－VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。下のコードはエクスプローラの現在のフォルダパスが表示されるところに（添付ファイル参照）文字を入れるものです。最後のSendMessageAnyで１が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。なおハンドルの値は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
- ベストアンサー
- Windows 7
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 ***以上ソース終わり***
- 締切済み
- Visual Basic
ExcelVBAでのkernel32(64bit)
今までExcel2000のVBAから、以下のようなコードを使ってC++で作ったコマンドプロンプトで動くプログラムを動かすプログラムを作っていましたが、これを64bitのWindows7上で動いているExcel2010で使おうとしたらメッセージが出ました。いろいろ調べてみたところ、たぶんDeclareにPtrSafeを付ければ良いようなのですが、その際、他のコードはそのままで良いのでしょうか。特に、コード中のLongはそのままで良いのか気になるのですが...。ちなみに、下記コードの条件コンパイルはネットで調べて見よう見まねで付けたもので、Excel2000のときには付けていないものでした。ご存じの方がいらっしゃいましたらご教授ください。 '------------------------------------------------------------------------------ ' Win32 API関数・定数の宣言 '------------------------------------------------------------------------------ #If VBA7 And Win64 Then '64bit Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ 　　ByVal dwMilliseconds As Long) As Long Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ 　　ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #Else '32bit Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ 　　ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ 　　ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #End If Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const INFINITE As Long = &HFFFF '------------------------------------------------------------------------------ ' Run '------------------------------------------------------------------------------ Public Sub Run(ByVal project_name As String) 　　Dim program As String 　　Dim task_id As Long 　　Dim h_proc As Variant 　　program = mdlFunc.ProgramPath() & mdlFunc.ProgramOption(project_name) 'プログラム名　　task_id = Shell(program, vbHide) 　　h_proc = OpenProcess(PROCESS_ALL_ACCESS, False, task_id) 　　If OpenProcess(PROCESS_ALL_ACCESS, False, task_id) <> vbNull Then 　　　　Call WaitForSingleObject(h_proc, INFINITE) 　　　　CloseHandle h_proc 　　End If End Sub
- ベストアンサー
- Visual Basic
API FtpPutFileの戻り値
お世話になっております。 API FtpPutFileを使用しているのですが確実にFalseになります。一日悩みましたが原因がわかりません。 If FtpPutFile(lngConnect, _ "***.txt", _ "***.txt", _ FTP_TRANSFER_TYPE_ASCII, _ 0&) <> False Then です。必要なものを付け加えておきます。 Private Declare Function FtpPutFile Lib "wininet.dll" _ Alias "FtpPutFileA" _ (ByVal hFtpSession As Long, _ ByRef lpszLocalFile As String, _ ByRef lpszNewRemoteFile As String, _ ByVal dwFlags As Long, _ ByVal dwContext As Long) As Long Private Const FTP_TRANSFER_TYPE_ASCII = &H1& です。環境はWinXP,VB6+SP5 よろしくお願い致します。
- ベストアンサー
- Visual Basic

EXCELVBA フォルダ検索API