フォルダの参照

「フォルダ参照」のダイアログを汎用関数化したものです。
10年とは長いもので....   このサイトも20138月で丸10年を迎え、20144月には長年主力であったWindowsXPもサポート切れとなりました。
主力OSWindows7や、それ以降のバージョンとなって、例えばこのページで従来紹介していたShell.ApplicationWindowsAPIによる方法は使用できなくなったわけではありませんが「古くなった」感があります。 特に企業内で「フォルダ参照」の用途といえばファイルサーバなどネットワーク先のフォルダを指定するケースが多いわけですが、少なくともWindows7WindowsXPと比べると「ネットワークの場所」が使いにくく、どうしてもデスクトップなどのショートカットからネットワーク先のフォルダに出て行く運用になりがちです。

ここで問題になるのは、従来のShell.ApplicationWindowsAPIによる「フォルダ参照」ではショートカットが表示されないので場合によってはネットワーク先のフォルダが指定できない状況になってしまうということです。
ファイル名の指定ダイアログで従来から利用されている「ファイルを開く(GetOpenFilename)」や「名前を付けて保存(GetSaveAsFilename)」はExcel95,97時代からある古いメソッドのままでもWindows7上でExcel2010などで利用する場合には フォルダのショートカットが表示されてネットワーク先のフォルダに出て行くことができますが、「フォルダ参照」ではダメだったわけです。

「フォルダ参照」でショートカットによるフォルダの参照先の移動ができる方法としては"Application.FileDialog"が良いようです。
"Application.FileDialog"自体は特に新しいものではありませんが、このサイトでは長い間「ノーマーク」でしたので、20144月の段階でこのページは差し替えることにいたしました。 Shell.ApplicationWindowsAPIによる方法についてはページの最後にサンプルダウンロードだけ残してあります。

「汎用関数化」として意図しているのは以下の項目です。
・フォルダを指定する場合の開始フォルダを指定することができる
・連続してフォルダ指定を行なう場合に前回指定したフォルダが再現して表示できる
・ネットワークドライブ配下のフォルダを指定してもUNCパスを返すことができるようにする
Application.FileDialogを用いた方法です。
下記の画像や「ダウンロード」ボタンからダウンロードした圧縮ファイルを解凍すると、
  • MsoFolderPicker1.xls」のサンプルExcelブック
  • modFolderPicker1.bas」のモジュールファイル
の2点が作成されます。
サンプルExcelブック「MsoFolderPicker1.xls」の方を起動させると動作確認ができます。
フォルダの参照(組み込みモジュール)
(この画像をクリックすると、ダウンロードができます。)
modFolderPicker1.bas」が「フォルダの参照」のメインモジュールです。組み込みの際はこれをプロジェクトにインポートさせて下さい。 「MsoFolderPicker1.xls」には「modFolderPicker1.bas」が組み込まれた状態になっています。

左上の「フォルダの参照」ボタンをクリックすると、
フォルダの参照(組み込みモジュール)
このようにフォルダ名を取得するためのダイアログが表示されます。
サンプルは「OK」をクリックした時に取得したフォルダのフルパス名をメッセージボックスに表示させるだけになっています。 このサンプル画像はWindows8での画像です。Windowsの世代によって左ペインの動作が異なります。

今回、汎用関数化したプロシージャは「FolderDialog」と名付けました。
呼び出しサンプルのコード(Module1)は以下の通りです。

'*******************************************************************************
'   フォルダ参照のダイアログ処理(シートからの呼び出し部分)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit
Public Const g_cnsTitle = "フォルダを指定して下さい"
Public Const g_cnsRootPath = "C:\"      ' ルートフォルダ
Public Const g_cnsFixRootPath = 1       ' ルートフォルダ以外を選択不可にする時は1に
                                        ' キャンセル時に初期化する時は3に

'*******************************************************************************
' [フォルダの参照]ダイアログの表示
'*******************************************************************************
Sub Button1_Click()
    Dim strPathName As String
    '---------------------------------------------------------------------------
    ' 「フォルダの参照」ダイアログよりフォルダ名の取得(引数は呼び先記述を参照)
    ' ※2つ目以降の引数は省略が可能です。
    strPathName = modFolderPicker1.FolderDialog( _
        g_cnsTitle, _
        True, _
        g_cnsRootPath, _
        g_cnsFixRootPath, _
        CurDir, _
        "選択")
    '---------------------------------------------------------------------------
    ' 結果の表示
    If strPathName <> "" Then MsgBox strPathName
End Sub

'----------------------------<< End of Source >>--------------------------------
本ページのソース記述は説明の都合上で「Button1_Click」だけになっていますが、 ダウンロードされたサンプルの方は上記画像の6つのボタンに対応するそれぞれのプロシージャが記述されています。 「フォルダ参照」だけでなく「ファイルを開く」や「名前を付けて保存」の汎用関数の呼び出しも含まれています。

Button1_Click」のコードでは「FolderDialog」プロシージャの呼び出しで6つの引数をセットさせていますが、2番目以降は省略可能です。 それぞれの引数の意味は以下のようになります。
項目 説明
@タイトル 表示ダイアログのタイトルです
AUNCパス変換 (OPTION)ネットワークドライブから指定された時に、該当のネットワークリソース名に変換する場合は、True、そうでない場合はFalseを指定します。
Bルートフォルダ (OPTION)選択状態にするフォルダがある場合はここで指定します。ブランクの場合は初期化用ルートフォルダから指定できるようになります。
Cルートフォルダ固定スイッチ (OPTION)上記「初回ルートフォルダ」以外を選択させないようにする場合は「1」を指定します。「0」の場合は初回以降は前回選択フォルダを保持した状態で表示され、「2」の場合は毎回「初回ルートフォルダ」に戻り、「3」の場合は前回選択フォルダを保持しますがキャンセルした時だけ「初回ルートフォルダ」に戻るようになります。
D初期化用ルートフォルダ (OPTION)初期化次に選択状態にするフォルダがある場合はここで指定します。ブランクの場合はカレントフォルダから指定できるようになります。
Eボタン表示名 (OPTION)デフォルトで「OK」となるボタンの表示名を指定することができます。

modFolderPicker1.bas」のソースコードは以下のようになっています。 ここでも提示は「フォルダ参照」の部分のみとさせていただきます。


'*******************************************************************************
'   ファイル、フォルダ参照のダイアログ処理(Application.FileDialog)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
'変更日付 Rev  変更履歴内容---------------------------------------------------->
'14/04/14(1.00)新規作成
'*******************************************************************************
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const g_cnsYen As String = "\"
Private Const g_cnsCol As String = ":"
' ■ローカルドライブからマウントされているネットワークリソース名を取得する
Private Declare Function WNetGetConnection Lib "MPR.dll" _
    Alias "WNetGetConnectionA" _
    (ByVal lpszLocalName As String, _
     ByVal lpszRemoteName As String, _
     cbRemoteName As Long) As Long

'*******************************************************************************
'   「フォルダの参照」ダイアログを表示させ、選択したフォルダ名を返す
'-------------------------------------------------------------------------------
'   引渡値 = @ウィンドウタイトル
'         Aネットワークドライブ→ネットワークリソースの置換区分(Option)
'         Bルートフォルダ(Option)
'            Cルートフォルダ固定スイッチ
'              (Option, 1=固定する, 2=ルートに戻す, 3=キャンセル時は初期化)
'         D初期化用ルートフォルダ(Option)
'            Eボタン表示名(Option)
'   戻り値 = フォルダ名(フルパスで右\なし、未選択時はブランク)
'-------------------------------------------------------------------------------
'  作成日:2014年04月14日
'  作成者:井上 治
'  更新日:2014年04月14日
'  更新者:井上 治
'*******************************************************************************
Public Function FolderDialog(strTitle As String, _
                             Optional blnNetGetConnection As Boolean = False, _
                             Optional strRootPath As String = "", _
                             Optional swFixRootPath As Integer = 0, _
                             Optional strDefaultRootPath As String = "", _
                             Optional strButtonName As String = "OK") As String
    '---------------------------------------------------------------------------
    Static strPrevDir As String
    Dim strPathName As String, strPathName2 As String
    ' ファイルダイアログの表示(FolderPicker)
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = strTitle
        ' ルートフォルダの設定
        Call GP_SetRootPathName( _
            .InitialFileName, strPrevDir, strRootPath, strDefaultRootPath, swFixRootPath)
        ' ボタン名の設定
        If Len(strButtonName) > 0 Then
            .ButtonName = strButtonName
        End If
        .InitialView = msoFileDialogViewDetails
        .AllowMultiSelect = False
        If .Show Then
            strPathName = .SelectedItems(1)
            ' ローカルドライブ(ネットワークドライブ)から
            ' マウントされているネットワークリソース名を取得する
            If (blnNetGetConnection And (Mid$(strPathName, 2, 1) = g_cnsCol)) Then
                strPathName2 = GetResourceNameFromLocalDrive(strPathName)
                If Left(strPathName2, 2) = g_cnsYen & g_cnsYen Then
                    strPathName = strPathName2 & Mid$(strPathName, 3)
                End If
            End If
            If ((swFixRootPath = 0) Or (Len(strPrevDir) = 0)) Then
                strPrevDir = strPathName
            End If
        ElseIf swFixRootPath = 3 Then
            ' キャンセル時は初期化の指定
            strPrevDir = strDefaultRootPath
        End If
    End With
    FolderDialog = strPathName
End Function

'*******************************************************************************
'   ネットワークドライブシンボルからネットワークリソースを取得
'-------------------------------------------------------------------------------
'   引渡値 = @パス名
'   戻り値 = パス名
'-------------------------------------------------------------------------------
'  作成日:2014年04月14日
'  作成者:井上 治
'  更新日:2014年04月14日
'  更新者:井上 治
'*******************************************************************************
Public Function GetResourceNameFromLocalDrive(strDrv As String) As String
    Dim strBuf As String
    Dim strDriveName As String
    Dim lngLen As Long
    '---------------------------------------------------------------------------
    strDriveName = Left$(strDrv, 1) & g_cnsCol
    On Error GoTo GetResourceNameFromLocalDrive_ERROR
    strBuf = String$(MAX_PATH + 1, vbNullChar)
    WNetGetConnection strDriveName, strBuf, MAX_PATH
    '取得したパス名から必要な文字列だけを抽出
    lngLen = InStr(1, strBuf, vbNullChar)
    If lngLen > 1 Then
        GetResourceNameFromLocalDrive = Left$(strBuf, lngLen - 1)
    Else
        GetResourceNameFromLocalDrive = strDriveName
    End If
    On Error GoTo 0
    Exit Function

'-------------------------------------------------------------------------------
GetResourceNameFromLocalDrive_ERROR:
    GetResourceNameFromLocalDrive = strDriveName
End Function

'*******************************************************************************
' ■■■ 内部共通プロシージャ ■■■
'*******************************************************************************
'   ルートフォルダの設定(Private)
'-------------------------------------------------------------------------------
'   引渡値 = @Application.FileDialogのInitialFileName
'         A直前使用フォルダ
'         Bルートフォルダ
'         C初期化用ルートフォルダ
'            Dルートフォルダ固定スイッチ
'              (0=通常, 1=固定する, 2=ルートに戻す, 3=キャンセル時は初期化)
'-------------------------------------------------------------------------------
'  作成日:2014年04月14日
'  作成者:井上 治
'  更新日:2014年04月14日
'  更新者:井上 治
'*******************************************************************************
Private Sub GP_SetRootPathName(ByRef strInitialFileName As String, _
                               ByRef strPrevDir As String, _
                               ByRef strRootPath As String, _
                               ByRef strDefaultRootPath As String, _
                               ByVal swFixRootPath As Integer)
    '---------------------------------------------------------------------------
    If Len(strRootPath) = 0 Then
        strRootPath = strDefaultRootPath
    End If
    If Len(strRootPath) > 0 Then
        If swFixRootPath = 1 Then
            ' ルートフォルダ固定の指定
            strPrevDir = strRootPath
        End If
        If ((Len(strPrevDir) <= 0) Or (swFixRootPath = 2)) Then
            strPrevDir = strRootPath
        End If
    End If
    If Len(strPrevDir) > 0 Then
        strInitialFileName = strPrevDir
    End If
End Sub

'----------------------------<< End of Source >>--------------------------------

先頭のコラムで「Windows7でネットワークの場所が使いにくい」と書いた理由を説明しておきます。
他のバージョンは検証できていませんが「資格情報マネージャー」により異なるドメインや非ドメインのネットワーク先の認証が保持できるようになったので、 ネットワークドライブを利用しなくても接続の都度認証のやりとりをすることはなくなりました。
ですが、ネットワーク参照先のフォルダ名に日本語が数文字以上含まれているとそのフォルダを直接開くことができず「target」というショートカットが表示されてしまいます。 この「target」をダブルクリックしてやっと参照先のフォルダが開くという動作になります。 一種の不具合に見えるのですが、Windows7の発売から数年経過している段階でもこの動作は変わっていません。
このため、ネットワーク先へ簡単に接続させるためにはデスクトップなどにショートカットを置くという運用になると思います。 ここで「フォルダ参照」ダイアログにもこのショートカットを経由してネットワーク先のフォルダへ移動させるという必要が発生するわけです。

ダウンロードはこちら。
←modFolderPicker1.zip
      (33KB)

従来バージョンが必要な方は以下からどうぞ
詳細な説明は削除してしまいましたが、ダウンロードはできるようにしてあります。

ダウンロードはこちら。
←modSHBrowseForFolder.zip
      (46KB)