【VBA×WindowsAPI】UserFormへのドラッグ＆ドロップでファイルパスを取得
VBAのUserFormにファイルを入力してもらう際にファイル選択ダイアログを使って入力させる手法は一般ですが、場合によってはUserFormへのドラッグ＆ドロップでファイルを入力させたいということがしばしばあります。このときUserFormのListViewコントロールを利用することでドラッグ＆ドロップされたファイルを取得することはできますが、このコントロールはVBA6時代のもののため環境によっては利用することが出来ない機能となっています。
ListViewコントロールは利用できないがどうしてもドラッグ＆ドロップ入力したいという場合、WindowsAPIを使うことでこれを解決することができます。処理内容としてはウィンドウに設定されているウィンドウプロシージャ(WNDPROC)というイベントを検知する関数にVBAで定義した関数を割り込ませるという、VBAでやるにはいささか強引な手法です。イメージとしてはUserFormのイベントの根源部分の処理にVBAでアクセスするようなイメージです。
本内容は処理内容としてはかなり複雑かつ間違えて実装するとアプリケーション(Excel等)が強制終了されるため細心の注意を払う必要のある手法です。正しく実装できれば問題なく利用することはできますがあまり推奨はできない内容のため、最終手段としてのみ使用することをお勧めします。
本ページは『サブクラス化とウィンドウプロシージャ』を理解している前提の内容となっています。サブクラス化やウィンドウプロシージャとは何かについてはリンク先ページを参照下さい。
UserFormへのドラッグ＆ドロップでファイルパスを取得
Windows APIを使うことで上動画の通り、UserFormにドラッグ＆ドロップされたファイル(フォルダ)のパスを取得することができます。上動画ではUserFormの全体がドラッグ＆ドロップの対象エリアとなっていますが、ListBoxやFrameなどのウィンドウハンドルが割り当てられるコントロールを指定することで、そのコントロールをドラッグ＆ドロップの対象エリアとして設定することも可能です。
VBAでUserFormにドラッグ＆ドロップされたファイルのパスを取得するには下記のWindows APIを利用します。それぞれ関数のより詳細な使い方の解説は各関数のリンクページを参照下さい。
FindWindow関数： ウィンドウハンドルを取得する
SetForegroundWindow関数： 指定ウィンドウを最前面に移動する
SetWindowLongPtr関数： ウィンドウプロシージャを設定する
CallWindowProc関数： 指定ウィンドウプロシージャにメッセージ情報を渡す
DragAcceptFiles関数： 指定ウィンドウにドラッグ＆ドロップ可否の設定をする
DragQueryFile関数： ドラッグ＆ドロップされたファイルのパスを取得する
DragFinish関数： ドラッグ＆ドロップ時に確保されたメモリを解放する
「そもそもWindows APIって何？」という方はコチラ(メインページ)も併せて参照下さい。
サンプルコード
下記はUserFormにドラッグ＆ドロップされたファイルのパスをすべて取得してメッセージボックスで表示するためのサンプルコードです。標準モジュールとUserFormそれぞれに下記コードをコピペすればすぐに実行可能です。(※vbModelessで表示したい場合はVBEを閉じて実行する必要があります)
標準モジュールコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
Option Explicit Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Declare PtrSafe Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As LongPtr, ByVal fAccept As Long) Declare PtrSafe Function DragQueryFile Lib "shell32" Alias "DragQueryFileA" (ByVal hDrop As LongPtr, ByVal iFile As Long, ByVal lpszFile As String, ByVal cch As Long) As Long Declare PtrSafe Function DragFinish Lib "shell32" (ByVal hDrop As LongPtr) As Long Public Const GWLP_WNDPROC = -4 Public Const WM_DROPFILES = &H233 Public lpPrevWndProc As LongPtr Public sPathDropped() As String '------------------------------------------------------------------------------ ' ﾒｲﾝ処理 '------------------------------------------------------------------------------ Sub main() UserForm1.Show End Sub '------------------------------------------------------------------------------ ' WINPROCｺｰﾙﾊﾞｯｸ関数 '------------------------------------------------------------------------------ Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Select Case uMsg '■ﾌｧｲﾙﾄﾞﾛｯﾌﾟｲﾍﾞﾝﾄ Case WM_DROPFILES Dim lCnt As Long Dim sBuf As String Dim sPath As String Dim sMsg As String Dim i As Long 'ｳｨﾝﾄﾞｳにﾄﾞﾛｯﾌﾟされたﾌｧｲﾙ数を取得 lCnt = DragQueryFile(wParam, &HFFFFFFFF, vbNullString, 0) '入力ﾌｧｲﾙ数に合わせて配列ｻｲｽﾞを変更 ReDim sPathDropped(lCnt - 1) '入力ﾌｧｲﾙﾙｰﾌﾟ For i = 0 To UBound(sPathDropped) 'ﾊﾟｽ受け取り用の固定長文字列を用意 sBuf = String(256, vbNullChar) 'ﾌｧｲﾙﾊﾟｽを取得 Call DragQueryFile(wParam, i, sBuf, Len(sBuf)) '受け取ったﾊﾟｽのうち不要な空文字を除去 sPath = Left(sBuf, InStr(sBuf, vbNullChar) - 1) 'ﾊﾟｽを配列に格納 sPathDropped(i) = sPath sMsg = sMsg & vbLf & sPath Next 'ﾒﾓﾘ解放 Call DragFinish(wParam) Call MsgBox("下記が入力されました。" & vbLf & sMsg) Exit Function End Select 'UserFormの本来のWndProcに処理を戻す WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam) End Function |
UserFormコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
Option Explicit Private hWndForm As LongPtr 'UserFormﾊﾝﾄﾞﾙ '------------------------------------------------------------------------------ ' UserForm起動時ｲﾍﾞﾝﾄ '------------------------------------------------------------------------------ Private Sub UserForm_Initialize() 'UserFormのｳｨﾝﾄﾞｳﾊﾝﾄﾞﾙを取得 hWndForm = FindWindow("ThunderDFrame", Me.Caption) 'UserFormにｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを登録 (ｻﾌﾞｸﾗｽ化) lpPrevWndProc = SetWindowLongPtr(hWndForm, GWLP_WNDPROC, AddressOf WndProc) 'UserFormへのﾄﾞﾗｯｸﾞ&ﾄﾞﾛｯﾌﾟを許可する Call DragAcceptFiles(hWndForm, True) End Sub '------------------------------------------------------------------------------ ' ﾌｧｲﾙﾄﾞﾗｯｸﾞｲﾍﾞﾝﾄ '------------------------------------------------------------------------------ Private Sub UserForm_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Control As MSForms.Control, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal State As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer) 'ﾌｧｲﾙﾄﾞﾗｯｸﾞでUserFormを最前面に移動 Call SetForegroundWindow(hWndForm) End Sub '------------------------------------------------------------------------------ ' UserForm終了時ｲﾍﾞﾝﾄ '------------------------------------------------------------------------------ Private Sub UserForm_Terminate() 'UserFormのｳｨﾝﾄﾞｳﾌﾟﾛｼｰｼﾞｬを元に戻す Call SetWindowLongPtr(hWndForm, GWLP_WNDPROC, lpPrevWndProc) 'UserFormへのﾄﾞﾗｯｸﾞ&ﾄﾞﾛｯﾌﾟを許可しない(元の設定に戻す) Call DragAcceptFiles(hWndForm, False) End Sub |
コード解説
UserFormにイベントを追加するにはUserFormウィンドウをサブクラス化する必要があります。UserFormウィンドウのサブクラス化およびイベントの追加にあたるウィンドウプロシージャ(WINPROC関数)の設定については『サブクラス化とウィンドウプロシージャ』を参照下さい。
UserFormへのドラッグ&ドロップを許可する
UserFromにファイルをドラッグ＆ドロップしてパスを取得するには、予めUserFormウィンドウへのファイルのドラッグ＆ドロップを許可する設定しておく必要があります。指定のウィンドウに対してドラッグ＆ドロップを許可する設定にするにはDragAcceptFiles関数を使い下記のように記載します。
Call DragAcceptFiles(hWnd, True)
第1引数の「hWnd」にはUserFormのウィンドウハンドル、第2引数には「True」を入力します。これによりUserFormウィンドウをファイルのドラッグ＆ドロップに対応したウィンドウとすることができます。このとき「hWnd」にUserFromコントロールのウィンドウハンドルを入力することで、指定のコントロールのみをドラッグ＆ドロップの対象エリアとして設定することも可能です。
ドラッグ&ドロップイベント(WINPROC関数)
ファイルがドラッグ＆ドロップされたときにウィンドウは「WM_DROPFILES(=&H233)」メッセージを受け取ります。そのためウィンドウプロシージャ(WINPROC関数)として下記のようなFunctionプロシージャをウィンドウに紐づければドラッグ＆ドロップ時の処理を設定することができます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
'------------------------------------------------------------------------------ ' WINPROCｺｰﾙﾊﾞｯｸ関数 '------------------------------------------------------------------------------ Public Function WndProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Select Case uMsg Case WM_DROPFILES 'ｳｨﾝﾄﾞｳにﾌｧｲﾙがﾄﾞﾗｯｸﾞ&ﾄﾞﾛｯﾌﾟされた時の処理 Exit Function End Select WndProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam) End Function |
ファイルパスの取得
ファイルがドロップされたことを検知したらまずは、ドロップされたファイルの総数を取得します。ドラッグ＆ドロップされたファイルの総数を取得するにはDragAcceptFiles関数を使い下記のように記載します。第1引数の「wParam」はWNDPROC関数の第3引数でそれ以外は定数値です。
lCnt = DragQueryFile(wParam, &HFFFFFFFF, vbNullString, 0)
ファイルの総数が取得できたらその数だけループを回して、ドロップされたファイル1つずつに対してパス取得の処理を行います。ドラッグ＆ドロップされたファイルのパスを取得するにはファイル総数の取得時と同じくDragAcceptFiles関数を使い下記のように記載します。
Call DragQueryFile(wParam, lIndex, sBuf, Len(sBuf))
第1引数の「wParam」にはWNDPROC関数の第3引数、第2引数の「lIndex」にはドロップされたファイルのインデックス(0始まり)、第3引数の「sBuf」にはファイルパスを受け取るための固定長文字列、第4引数には第3引数の大きさである「Len(sBuf)」を入力します。
ウィンドウにドラッグ＆ドロップされたファイル情報はメモリ上に保持されるため、DragFinish関数を使ってメモリを明示的に解放する必要があります。WNDPROC関数の第3引数である「wParam」を引数として入力することでメモリの解放を行うことができます。
Call DragFinish(wParam)
WNDPROC関数は指定の引数以外の設定ができないため、取得したパスはグローバル変数に格納しておくことが一般的です。サンプルコードでは配列に格納してドラッグ＆ドロップされた直後にメッセージボックスを表示するような処理としていますが、任意で書き換えても問題ありません。
関連情報
VBA×WindowsAPIまとめページ
その他のWindowsAPI関数は下記ページにまとまっているので合わせて参照下さい。
https://liclog.net/vba-windows-api-index/参考
Microsoft公式：ウィンドウ プロシージャの使用 – Win32 apps
