Function GetFileName(ByVal FilePath As String, ByVal GetTarget As String) As String
'ディレクトリパスの取得
Dim Pos As Long
Dim DirPath As String
Dim FileName As String
If InStr(FilePath, "\") Then
Pos = InStrRev(FilePath, "\")
DirPath = Left(FilePath, Pos - 1)
FileName = Mid(FilePath, Pos + 1)
Else
Pos = 0
DirPath = ""
FileName = FilePath
End If
' ファイル名と拡張子の取得
Dim Dot As Long
Dim FileBody As String
Dim FileExt As String
If InStr(FileName, ".") Then
Dot = InStrRev(FileName, ".")
FileBody = Left(FileName, Dot - 1)
FileExt = Mid(FileName, Dot + 1)
Else
Dot = 0
FileBody = FileName
FileExt = ""
End If
' 返り値の分岐
Select Case GetTarget
Case "Name": GetFileName = FileName: Exit Function
Case "Body": GetFileName = FileBody: Exit Function
Case "Ext": GetFileName = FileExt: Exit Function
Case "Path": GetFileName = DirPath: Exit Function
Case Else: MsgBox "Error:" & Br & "GetFileName()" & Br & "------------------------------" & Br & "第2引数の指定に誤りがあります。": Exit Function
End Select
End Function
Function ファイル名を取得(Arg As String) As String: ファイル名を取得 = GetFileName(Arg, "Name"): End Function
Function ファイル本体を取得(Arg As String) As String: ファイル本体を取得 = GetFileName(Arg, "Body"): End Function
Function 拡張子を取得(Arg As String) As String: 拡張子を取得 = GetFileName(Arg, "Ext"): End Function
Function ディレクトリパスを取得(Arg As String) As String: ディレクトリパスを取得 = GetFileName(Arg, "Path"): End Function
使用例
Sub sample()
MsgBox ファイル名を取得("C:\Sample\Sub\Book1.xls")
MsgBox ファイル本体を取得("C:\Sample\Sub\Book1.xls")
MsgBox 拡張子を取得("C:\Sample\Sub\Book1.xls")
MsgBox ディレクトリパスを取得("C:\Sample\Sub\Book1.xls")
End Sub
Top