【Excel VBA】ファイルまたはフォルダの選択

VBA

エクセルでファイルまたはフォルダを選択し、そのパスを表示するためのクラスモジュールと標準モジュールです。
表示されたフォルダパスやファイル名を使って、特定のフォルダ内のすべてのファイルを操作する等の様々なファイル操作が可能です。

(クラスモジュールについてはコチラの記事がわかりやすいです)
コチラの記事もおすすめです。

【ファイル選択】
下図の通り、「ファイル選択」ボタンをクリックすると、下の「ファイルを選択するダイアログボックス」が開き、対象のファイルを選択すると「フォルダパス」欄に選択したファイルの「フォルダパス」が、「ファイル名」欄に選択したファイルの「ファイル名」が、それぞれ表示されます。

【フォルダ選択】
下図の通り、「フォルダ選択」ボタンをクリックすると、下の「フォルダを選択するダイアログボックス」が開き、対象のフォルダを選択すると「フォルダパス」欄に選択したフォルダの「フォルダパス」が表示されます。

いずれも「キャンセル」をクリックした場合は、「フォルダパス」欄、「ファイル名」欄ともに空欄となります。

【コード】

コードは「クラスモジュール」と「標準モジュール」に記載します。

まずは、下記のコードを「クラスモジュール」に貼り付けます。
ここではモジュール名を「Cls_FlFldr_Slctr」としました。

<クラスモジュール>

Option Explicit

Private iniPath_ As String
Private titleMsg_ As String
Private fullPath_ As Variant
Private fileName_ As Variant
Private fileFilter_ As String
Private folderPath_ As Variant

Private Const CANCELMSG As String = _
                    "「キャンセル」ボタンをクリックしたので、処理を終了します。"

Public Sub Cls_Setting(ByVal setIniPath As String, _
                        ByVal setTitleMsg As String, _
                        Optional ByVal setfileFilter As String = _
                                            "Excelかcsv,*.xls?;*.csv")
                        
    iniPath_ = setIniPath
    titleMsg_ = setTitleMsg
    fileFilter_ = setfileFilter
    
End Sub

Property Get FileName() As Variant
    FileName = fileName_
End Property

Property Get FolderPath() As Variant
    FolderPath = folderPath_
End Property

Public Sub Cls_File_Select()

    ChDir iniPath_
    MsgBox titleMsg_
    fullPath_ = Application.GetOpenFilename _
                    (filefilter:=fileFilter_, Title:=titleMsg_)
    If fullPath_ = False Then
        MsgBox CANCELMSG
        Exit Sub
    End If
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    fileName_ = FSO.GetFileName(fullPath_)
    folderPath_ = FSO.GetParentFolderName(fullPath_)
    
End Sub

Sub Cls_Folder_Select()

    MsgBox titleMsg_
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = iniPath_
        .Title = titleMsg_
        If .Show = False Then
            MsgBox CANCELMSG
            Exit Sub
        End If
        folderPath_ = .SelectedItems(1)
    End With
    
End Sub

なお、「FileSystemObject」は、「事前バインディング」ではなく、「実行時バインディング」で記載しています。

「事前バインディング」および「実行時(遅延)バインディング」についてはコチラ
⇒一般的には「事前バインディング」が推奨されておりますが、当方では、環境の異なる複数のユーザがこのVBAを利用しておりますので、「実行時バインディング」で記載していました。

次に、下記のコードを「標準モジュール」に貼り付けます。

<標準モジュール>

Option Explicit

Sub New_File_Select()

    Dim trgWs As Worksheet: Set trgWs = ActiveSheet
    Dim objFileSlct As Cls_FlFldr_Slctr
  Set objFileSlct = New Cls_FlFldr_Slctr
    Dim iniPath As String: iniPath = "C:\Users\"  '最初に開くフォルダを指定
    Dim titleMsg As String: titleMsg = "対象のファイルを選択してください。"
    
    With objFileSlct
        Call .Cls_Setting(iniPath,titleMsg)
        '状況に応じて、第3引数にファイルフィルターを設定
        '(規定値は「"Excelかcsv,*.xls?;*.csv"」)
        Call .Cls_File_Select
        trgWs.Range("フォルダフルパス表示_ファイル選択時") = .FolderPath
        trgWs.Range("ファイル名表示") = .FileName
    End With
    
    Set objFileSlct = Nothing
    Set trgWs = Nothing
    
End Sub

Sub New_Folder_Select()

    Dim trgWs As Worksheet: Set trgWs = ActiveSheet
    Dim objFldrSlct As Cls_FlFldr_Slctr
  Set objFldrSlct = New Cls_FlFldr_Slctr
    Dim iniPath As String: iniPath = "C:\Users\"  '最初に開くフォルダを指定
    Dim titleMsg As String: titleMsg = "対象のフォルダを選択してください。"
    
    With objFldrSlct
        Call .Cls_Setting(iniPath,titleMsg)
        '状況に応じて、第3引数にファイルフィルターを設定
        '(規定値は「"Excelかcsv,*.xls?;*.csv"」)
        Call .Cls_Folder_Select
        trgWs.Range("フォルダフルパス表示_フォルダ選択時") = .FolderPath
    End With
    
    Set objFldrSlct = Nothing
    Set trgWs = Nothing
    
End Sub

最後に、上記「標準モジュール」のSubプロシージャ「New_File_Select」を「ファイル選択」ボタンに、Subプロシージャ「New_Folder_Select」を「フォルダ選択」ボタンに、それぞれ割り当てます。

コメント

タイトルとURLをコピーしました