ファイルのベース名・拡張子の取得2012.09.27 [更新日]2024.11.28
ファイルパス・ファイル名から、ファイルのベース名と拡張子を取得するサンプルコードとメモです。
ポイント
・FileSystemObject を利用したファイルのベース名・拡張子の取得
[参考]Microsoft Learn Challenge FileSystemObject オブジェクト
【お薦め】マクロ・プロシージャを管理する無料のツール!
Excelマクロ管理ツール
Excelマクロ管理ツール
サンプルコード
ファイルパス・ファイル名からファイルベース名と拡張子を取得
'----------------------------------------------------------------- ' ファイルのベース名・拡張子の取得・表示 '----------------------------------------------------------------- ' '[作成日]2012.09.27 [更新日]2024.11.28 ' https://excel.syogyoumujou.com/memorandum/get_extension.html '----------------------------------------------------------------- Sub ファイルのベース名と拡張子を取得表示() '--------------------------------------- ' ファイル選択 '--------------------------------------- Dim varFilePath As Variant '《ファイル選択ダイアログボックス》 ' ・ 引数1:ファイルフィルター ' ・ 引数2:ファイルインデックス(既定で表示するフィルター文字列の指定) ' ・ 引数3:ダイアログボックスタイトル(既定:"ファイルを開く") ' ・ 引数4:ボタンテキスト(Macintosh用) ' ・ 引数5:複数選択の設定(True:複数選択可 False:複数選択不可) varFilePath = Application.GetOpenFilename("すべてのファイル,*.*", _ , _ "ファイルを選択してください", _ , _ False) '[キャンセル]ボタンをクリックした場合は抜ける If VarType(varFilePath) = vbBoolean Then Exit Sub ' ファイルを複数選択の場合は最初のファイルパスを対象とする If IsArray(varFilePath) Then varFilePath = varFilePath(LBound(varFilePath)) '--------------------------------------- ' ファイルベース名取得 '--------------------------------------- Dim strBaseName As String strBaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(varFilePath) '--------------------------------------- ' 拡張子取得 '--------------------------------------- Dim strExtention As String strExtention = CreateObject("Scripting.FileSystemObject").GetExtensionName(varFilePath) '--------------------------------------- ' 結果表示 '--------------------------------------- MsgBox "ファイルベース名:" & strBaseName & vbLf & _ "拡張子:" & strExtention End Sub
VBAコードをカラーで印刷・Web掲載するためのツールはこちら
メモ
GetOpenFilename
ファイルベース名取得関数・拡張子取得関数 サンプルコード
コードの中で何度もファイルベース名や拡張子を取得する場合は、関数にしておくと利便性が高いため、メモとして追加。
'----------------------------------------------------------------- ' 列挙型 ※ 列挙型は標準モジュールの宣言セクションに記載します '----------------------------------------------------------------- ' 情報の種類 Enum TypeOfInfomation ドライブ名 親フォルダ名 ファイル名 ベース名 拡張子 End Enum
'----------------------------------------------------------------- ' ファイルフルパスから情報取得 '----------------------------------------------------------------- '[引数] ' FileFullPath:ファイルフルパス ' TypeOfInfo :情報の種類 '[戻り値] ' 成功 :引数に対応した文字列 ' 失敗 :空の文字列 '[作成日]2012.09.27 [更新日]2024.11.28 ' https://excel.syogyoumujou.com/memorandum/get_extension.html '----------------------------------------------------------------- Function getInfomationFromFilePath(ByVal FileFullPath As String, _ ByVal TypeOfInfo As TypeOfInfomation) As String With CreateObject("Scripting.FileSystemObject") Select Case TypeOfInfo Case ドライブ名 getInfomationFromFilePath = .GetDriveName(FileFullPath) Case 親フォルダ名 getInfomationFromFilePath = .GetParentFolderName(FileFullPath) Case ファイル名 getInfomationFromFilePath = .GetFileName(FileFullPath) Case ベース名 getInfomationFromFilePath = .GetBaseName(FileFullPath) Case 拡張子 getInfomationFromFilePath = .GetExtensionName(FileFullPath) End Select End With End Function
'----------------------------------------------------------------- ' ファイルフルパスから情報取得関数の使用例 '----------------------------------------------------------------- Sub 指定フォルダ内のファイルのベース名と拡張子の一覧作成() '-------------------------------- ' フォルダの選択 '-------------------------------- Dim strFolderPath As String With Application.FileDialog(msoFileDialogFolderPicker) .Title = "対象フォルダを選択してください" If .Show = True Then strFolderPath = .SelectedItems(1) End With If Len(strFolderPath) = 0 Then Exit Sub '-------------------------------- ' フォルダの存在確認 '-------------------------------- If Dir(strFolderPath, vbDirectory) = "" Then MsgBox "対象のフォルダが見つかりません", vbExclamation, "終了します" Exit Sub End If '-------------------------------- ' フォルダ内ファイルを検索 '-------------------------------- Dim strFileName As String strFolderPath = strFolderPath & Application.PathSeparator ' フォルダパスに区切り文字追加 strFileName = Dir(strFolderPath & "*.*") ' フォルダからファイルを検索 If strFileName = "" Then ' ファイルパスを取得できなければ終了 MsgBox "指定フォルダ内にファイルが見つかりません", vbExclamation, "終了します" Exit Sub End If '-------------------------------- ' 新規ブックに出力 '-------------------------------- Dim shtNew As Worksheet Set shtNew = Workbooks.Add.Worksheets(1) shtNew.Columns("A:B").NumberFormatLocal = "@" ' A・B列の表示形式を文字列に設定 shtNew.Range("A3:B3").Value = Array("ファイルベース名", "拡張子") Dim lngCount As Long Dim strFullPath As String Dim strBaseName As String Dim strExtension As String Do ' ファイルフルパス作成 strFullPath = strFolderPath & strFileName '《ファイルフルパスから情報取得》 ' ・ 引数1 : ファイルのフルパス ' ・ 引数2 : 取得する情報の種類(列挙型 TypeOfInfomation から選択) strBaseName = getInfomationFromFilePath(strFullPath, ベース名) ' ベース名取得 strExtension = getInfomationFromFilePath(strFullPath, 拡張子) ' 拡張子取得 ' 新規ブックに出力 shtNew.Cells(4 + lngCount, "A").Resize(1, 2).Value = Array(strBaseName, strExtension) lngCount = lngCount + 1 ' 次のファイルを検索 strFileName = Dir() Loop Until strFileName = "" shtNew.Columns("A:B").AutoFit shtNew.Range("A1:B1").Value = Array("対象フォルダ", Left$(strFolderPath, Len(strFolderPath) - 1)) End Sub