VBATips
パーツ化

「フルパスから、パス、ファイル名、拡張子を分ける処理」をパーツ化する【ExcelVBA】

2020.07.23

パーツ化とは

ExcelVBAマクロ初級者からの脱却が、処理のパーツ化(プロシージャの分割)と考えています。
マクロを作る上で基本機能をパーツ化する事で、開発時間の削減に繋がります。
処理はパーツ単位で分ける事を心掛けましょう。

分かりやすく説明すると、エクセルの「関数」と同様です。
SUM関数であれば セル内に「=SUM(1+2+3)」と記載すれば、セルには「6」と表示されますよね。
値を渡せば正しい値で返ってくる動きです。

このコードをコピペでOK

'■フルパスからパスのみ抜き出す。C:\data\sample.xlsx → C:\data\
Public Function call_FullPath_PathNameGet(temp As String)
        
    '■InstrRev関数で「\」の位置を判断し、パス名のみ抜き出す
    call_FullPath_PathNameGet = Left(temp, InStrRev(temp, "\"))
End Function

'■フルパスからファイル名のみ抜き出す。C:\data\sample.xlsx → sample
Public Function call_FullPath_BaseNameGet(temp As String)
        
    '■InstrRev関数で「\」と「.」の位置を判断し、ファイル名のみ抜き出す
    call_FullPath_BaseNameGet = Mid(temp, InStrRev(temp, "\") + 1, InStrRev(temp, ".") - InStrRev(temp, "\") - 1)
    
End Function
'■フルパスから拡張子のみ抜き出す。C:\data\sample.xlsx → .xlsx
Public Function call_ExtensionNameGet(temp As String)
            
    '■InstrRev関数で「.」の位置を判断し、拡張子のみ抜き出す
    call_ExtensionNameGet = Right(temp, Len(temp) - InStrRev(temp, ".") + 1)
End Function

使い方

上記をコピペでお好きなモジュール内に記載してください。

Public Sub sample()
    Dim temp As String
    Dim PathName As String
    Dim Filename As String
    Dim ExtensionName As String

    '■ファイル名と拡張子を分ける
    temp = "C:\data\sample.xlsx"
    PathName = call_FullPath_PathNameGet(temp)     'C:\data\sample.xlsx → C:\data\
    Filename = call_FullPath_BaseNameGet(temp)     'C:\data\sample.xlsx → sample
    ExtensionName = call_ExtensionNameGet(temp)    'C:\data\sample.xlsx → .xlsx

End Sub

注意点

  • InstrRev関数はこちらの記事で詳しく説明しています。
  • 上記パーツを使用しなくても、以下で代用も可能です。
Public Sub sample()
    Dim temp As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    temp = "C:\data\sample.xlsx"
    
    '■ディレクトリ(パス名)　C:\data
    MsgBox fso.GetParentFolderName(temp)
    '■ディレクトリ(パス名)に「\」付与　C:\data\
    MsgBox fso.GetParentFolderName(temp) & "\"
    '■ファイル名（拡張子あり）　sample.xlsx
    MsgBox fso.GetFileName(temp)
    '■ファイル名（拡張子なし）sample
    MsgBox fso.GetBaseName(temp)
    '■拡張子のみ　.xlsx
    MsgBox fso.GetExtensionName(temp)

End Sub

コメント