Option Explicit

Public Function gDrive(ByVal sFileName As String) As String
'Argument: Dateiname inkl. Pfad
'Rückgabe: Laufwerk

  Dim nPos As Long

  On Error Resume Next
  If Left$(sFileName, 2) = "\\" Then
    nPos = InStr(3, sFileName, "\")
    gDrive = Left$(sFileName, nPos - 1)
  Else
    nPos = InStr(sFileName, ":")
    gDrive = Left$(sFileName, nPos)
  End If
  On Error GoTo 0
End Function

Public Function gPath(ByVal sFileName As String) As String
'Argument: Dateiname inkl. Pfad
'Rückgabe: Pfad ohne Dateinamen

  Dim nPos As Long

  nPos = InStrRev(sFileName, "\")
  If nPos <> 0 Then
    gPath = Left$(sFileName, nPos)
  End If
End Function

Public Function gFileTitle(ByVal sFileName As String) As String
'Argument: Dateiname inkl. Pfad
'Rückgabe: Dateiname ohne Pfad

  Dim nPos As Long

  nPos = InStrRev(sFileName, "\")
  If nPos <> 0 Then
    gFileTitle = Mid$(sFileName, nPos + 1)
  Else
    gFileTitle = sFileName
  End If
End Function

Public Function gFileWithoutExt(ByVal sFileTitle As String) _
      As String
'Argument: Dateiname ohne Pfad
'Rückgabe: Dateiname ohne Kennung/Endung

  Dim nPos As Long

  nPos = InStrRev(sFileTitle, ".")
  If nPos <> 0 Then
    gFileWithoutExt = Left$(sFileTitle, nPos - 1)
  Else
    gFileWithoutExt = sFileTitle
  End If
End Function

Public Function gFileExtension(ByVal sFileTitle As String) _
      As String
'Argument: Dateiname ohne Pfad
'Rückgabe: Kennung/Endung

  Dim nPos As Long

  nPos = InStrRev(sFileTitle, ".")
  If nPos <> 0 Then
    gFileExtension = Mid(sFileTitle, nPos + 1)
  End If
End Function

Dim strFileName As String
Dim strRetVal   As String

strFileName = "c:\temp\beispiel.vbp"

strRetVal = gDrive(strFileName)
MsgBox "Laufwerk:  " & strRetVal

strRetVal = gPath(strFileName)
MsgBox "Pfad ohne Dateiname:  " & strRetVal

strRetVal = gFileTitle(strFileName)
MsgBox "Dateiname ohne Pfad:  " & strRetVal

strRetVal = gFileWithoutExt(gFileTitle(strFileName))
MsgBox "Dateiname ohne Kennung/Endung:  " & strRetVal

strRetVal = gFileExtension(gFileTitle(strFileName))
MsgBox "Kennung/Endung:  " & strRetVal