自作WindowsAPIクラスにユーザが選択したフォルダのパスを返すFunctionを追加した

Win64/32API利用 VBA自作クラス VBA自作メソッド VBAクラス・モジュール


ユーザが選択したフォルダのパスを取得するFunction

相変わらず、WindowsAPIにハマっている。

今回も、名著『大村あつしのExcel VBA Win64/32 API プログラミング』を参考に、おなじみ、自作WindowsAPIクラスにメソッドを追加する。

akashi-keirin.hatenablog.com

このときにも書いたが、クラスモジュールWindowsAPIの他に、標準モジュールWinAPIEnums（参考）を使う。

列挙体だけでなく、構造体や定数の宣言用に使うことにした。今さらながら、WinAPIConstantsとでもしておけば良かった……。これは今後変更するかも知れぬ。

では早速。

ちなみに、今回参考にしたのは、

f:id:akashi_keirin:20190105203721j:plain

我らが教科書『大村あつしのExcel VBA Win64/32 API プログラミング』の130～137ページです。

構造体と定数の宣言

今回使用するWindowsAPI関数は、

  1. FindWindow関数
  2. SHBrowseForFolder関数
  3. SHGetPathFromIDList関数
  4. CoTaskMemFree関数

の四つ。

このうち、FindWindow関数は、すでに

akashi-keirin.hatenablog.com

このときに使用済み。

これらの関数のうち、SHBrowseForFolder関数で引数に構造体を使うこと、また、その構造体に値をセットする際に定数を使用することから、標準モジュールWinAPIEnumsに構造体と定数を追加する。

リスト１　標準モジュール宣言セクション
'CustomTypes'
Public Type BrowseInfo
  biHwndOwner As Long
  biPidRoot As Long
  biPszDisplayName As String
  biLpszTitle As String
  biUlFlags As Long
  biLpfn As Long
  biLParam As Long
  biIImage As Long
End Type

'Constants'
'ルートフォルダを指定する定数'
Public Const CSIDL_DESKTOP As Long = &H0&
Public Const CSIDL_PROGRAMS As Long = &H2&
Public Const CSIDL_CONTROLS As Long = &H3
Public Const CSIDL_PRINTERS As Long = &H4
Public Const CSIDL_PERSONAL As Long = &H5
Public Const CSIDL_FAVORITE As Long = &H6
Public Const CSIDL_STARTUP As Long = &H7
Public Const CSIDL_RECENT As Long = &H8
Public Const CSIDL_SENDTO As Long = &H9
Public Const CSIDL_BITBUCKET As Long = &HA
Public Const CSIDL_STARTMENU As Long = &HB
Public Const CSIDL_DESKTOPDIRECTORY As Long = &H10
Public Const CSIDL_DRIVES As Long = &H11
Public Const CSIDL_NETWORK As Long = &H12
Public Const CSIDL_NETHOO As Long = &H13
Public Const CSIDL_FONTS As Long = &H14
Public Const CSIDL_TEMPLATES As Long = &H15
'動作方法を指定する定数'
Public Const BIF_RETURNONLYSDIRS As Long = &H1
Public Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Public Const BIF_STATUSTEXT As Long = &H4
Public Const BIF_RETURNFSCANCESTORS As Long = &H8
Public Const BIF_EDITBOX As Long = &H10
Public Const BIF_VALIDATE As Long = &H20
Public Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Public Const BIF_BROWSEFORPRINTER As Long = &H2000
Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000

これらのうち、今回実際に使うのはごく一部だが、挙動を変えたり、機能を追加したりするときに必要になってくるので、ひととおり全て書いてある。

WindowsAPI関数の宣言

お次は、WindowsAPI関数の宣言。これは、クラスモジュールWindowsAPIの宣言セクションに追加する。

リスト２　クラスモジュール宣言セクション
'ウインドウハンドル取得まわり'
Private Declare Function FindWindow Lib "user32" _
                  Alias "FindWindowA" (_
                           ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As Long
Private Declare Function GetNextWindow Lib "user32" _
                  Alias "GetWindow" ( _
                           ByVal hwnd As Long, _
                           ByVal wFlag As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" ( _
                           ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
                  Alias "GetWindowTextA" ( _
                           ByVal hwnd As Long, _
                           ByVal lpString As String, _
                           ByVal cch 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 SHBrowseForFolder Lib "shell32.dll" _
                  Alias "SHBrowseForFolderA" ( _
                           ByRef lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                  Alias "SHGetPathFromIDListA" ( _
                           ByVal pidlRoot As Long, _
                           ByVal pszDispName As String) As Long  '……(1)'
'メモリ解放まわり'
Private Declare Function CoTaskMemFree Lib "OLE32.dll" ( _
                           ByVal pv As Long) As Long

(1)の第２引数「pszDispName」については、

akashi-keirin.hatenablog.com

をご覧ください。

ユーザーが選択したフォルダパスを取得するメソッド

以上で準備は終わり。早速メソッドの本体のコードを載っけておこう。

リスト３　クラスモジュール
'ユーザが選択したフォルダのパスを取得するメソッド'
Public Function getSelectedFolderPath( _
                  ByVal prompt As String, _
                  ByVal targetApp As Application) As String
  getSelectedFolderPath = ""
  Dim str As String
  str = Trim(Replace(targetApp.Name, "Microsoft", ""))  '……(2)'
  Dim className As String
  className = getWindowClassName(str)  '……(3)'
  Dim browseInfo_ As BrowseInfo  '……(4)'
  With browseInfo_
    .biHwndOwner = FindWindow(className, Application.Caption)
    .biPidRoot = CSIDL_DESKTOP
    .biLpszTitle = prompt
    .biUlFlags = BIF_RETURNONLYSDIRS
  End With
  Dim pIdl As Long
  pIdl = SHBrowseForFolder(browseInfo_)  '……(5)'
  If pIdl = 0 Then Exit Function  '……(6)'
  Dim ret As String * MAX_PATH_SIZE
  Dim tmp As Long
  tmp = SHGetPathFromIDList(pIdl, ret)  '……(7)'
  getSelectedFolderPath = Left(ret, InStr(ret, vbNullChar) - 1)
  Call CoTaskMemFree(pIdl)  '……(8)'
End Function
'ウインドウのクラス名を取得するメソッド'
Public Function getWindowClassName( _
                  ByVal targetAppNameKeyWord As String) As String
  Dim gotClassName As String * 100
  Dim gotCaption As String * 200
  Dim hwnd As Long
  hwnd = FindWindow(vbNullString, vbNullString)
  Do
    If IsWindowVisible(hwnd) Then
      Call GetWindowText(hwnd, gotCaption, Len(gotCaption))
      If InStr(1, gotCaption, targetAppNameKeyWord) > 0 Then
        Call GetClassName(hwnd, gotClassName, Len(gotClassName))
        Dim ret As String
        ret = Left(gotClassName, InStr(gotClassName, vbNullChar) - 1)
        Exit Do
      End If
    End If
    hwnd = GetNextWindow(hwnd, GW_HWNDNEXT)
  Loop Until hwnd = GetNextWindow(hwnd, GW_HWNDLAST)
  getWindowClassName = ret
End Function

後半のgetWindowClassNameは、前回のリスト３と同じ。今回追加したgetSelectedFolderPath内で使うので、再掲した次第。

(2)の

str = Trim(Replace(targetApp.Name, "Microsoft", ""))

では、(3)のgetWindowClassNameに渡す引数を作るためにReplace関数とTrim関数を用いてアプリケーション名（「Excel」とか「Word」とか）を取り出している。

(3)の

className = getWindowClassName(str)

では、自作のgetWindowClassNameを用いて、アプリケーションのクラス名（Excelだったら「XLMAIN」）を取得し、変数classNameにぶち込んでいる。

(4)からの７行

Dim browseInfo_ As BrowseInfo
With browseInfo_
  .biHwndOwner = FindWindow(className, Application.Caption)
  .biPidRoot = CSIDL_DESKTOP
  .biLpszTitle = prompt
  .biUlFlags = BIF_RETURNONLYSDIRS
End With

では、上のリスト１で宣言した構造体BrowseInfo型の変数browseInfo_を準備して、値をぶち込んでいる。

先ほど(2)、(3)で準備したアプリケーションのクラス名は、

.biHwndOwner = FindWindow(className, Application.Caption)

のところで、FindWindow関数の引数として使用している。

これで、BrowseInfo型の変数browseInfo_に値のセットが終わったので、(5)の

pIdl = SHBrowseForFolder(browseInfo_)

でSHBrowseForFolderを呼ぶ。

ここで、フォルダ選択ダイアログが表示されることになる。

ユーザーがフォルダを選んで[OK]、または[キャンセル]をクリックするとコード実行再開。

ユーザーが[キャンセル]をクリックしていたら、SHBrowseForFolderが「0」を返すので、(6)の

If pIdl = 0 Then Exit Function

で処理を抜ける。このとき、getSelectedFolderPathは「""」を返す。

何らかのフォルダを選んで[OK]をクリックした場合は、(7)からの２行

tmp = SHGetPathFromIDList(pIdl, ret)
getSelectedFolderPath = Left(ret, InStr(ret, vbNullChar) - 1)

で、SHGetPathFromIDListにSHBrowseForFolderの返り値pIdlを渡す。

SHGetPathFromIDListを実行する過程で「ret」には、ユーザが選択したフォルダパスが固定長の文字列がぶち込まれ、

Left(ret, InStr(ret, vbNullChar) - 1)

によって必要な文字列だけが切り出されてgetSelectedFolderPathの返り値としてreturnされることとなる。

あとは、(8)の

Call CoTaskMemFree(pIdl)

でメモリを解放して終わり。

使ってみる

イミディエイト・ウインドウに

?WindowsAPI.getSelectedFolderPath("フォルダを選択してください",Excel.Application)

と打ち込んで、[Enter]をそっと押す。

すると、

f:id:akashi_keirin:20190112225654j:plain

まず、フォルダダイアログが表示される。

f:id:akashi_keirin:20190112225705j:plain

テキトーにフォルダを選択して[OK]をクリックする。

f:id:akashi_keirin:20190112225714j:plain

バッチリ。

おわりに

筆者の大村あつし氏もおっしゃるように、VBAだけでは、フォルダ選択ダイアログを表示させることはできないので、ツール作りをする人にとってはめっちゃ便利なのではないかと思いました。

ちなみに、画像ではまったく伝わりませんが（笑）、

f:id:akashi_keirin:20190112225818j:plain

Wordでもフツーに動きます。

たぶん、OutlookとかPowerpointでも大丈夫だと思いますが、保証はしまへん。