エクセルでファイルまたはフォルダを選択し、そのパスを表示するためのクラスモジュールと標準モジュールです。
表示されたフォルダパスやファイル名を使って、特定のフォルダ内のすべてのファイルを操作する等の様々なファイル操作が可能です。
(クラスモジュールについてはコチラの記事がわかりやすいです)
コチラの記事もおすすめです。
【ファイル選択】
下図の通り、「ファイル選択」ボタンをクリックすると、下の「ファイルを選択するダイアログボックス」が開き、対象のファイルを選択すると「フォルダパス」欄に選択したファイルの「フォルダパス」が、「ファイル名」欄に選択したファイルの「ファイル名」が、それぞれ表示されます。
【フォルダ選択】
下図の通り、「フォルダ選択」ボタンをクリックすると、下の「フォルダを選択するダイアログボックス」が開き、対象のフォルダを選択すると「フォルダパス」欄に選択したフォルダの「フォルダパス」が表示されます。
いずれも「キャンセル」をクリックした場合は、「フォルダパス」欄、「ファイル名」欄ともに空欄となります。
【コード】
コードは「クラスモジュール」と「標準モジュール」に記載します。
まずは、下記のコードを「クラスモジュール」に貼り付けます。
ここではモジュール名を「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」を「フォルダ選択」ボタンに、それぞれ割り当てます。
コメント