Function ExPaLoFi(vPath As String, vbOpt As Byte)
'extrait d'un filelongname d'un fichier local une chaine selon option vbOpt
'Option 0 : extension du fichier avec "."
'Option 1 : nom du fichier sans extension
'Option 2 : Path avec "\" final
'Option 3 : Nom du Dossier
'Option 4 : Nom du Dossier Parent
Dim vStr() As String
Dim Txt As String
On Error GoTo ErrLine
If vbOpt > 4 Then
Err.Raise 5
End If
ReDim vStr(0 To 4)
'extension
vStr(0) = ""
Txt = vPath
Do While Left(vStr(0), 1) <> "."
vStr(0) = Right(Txt, 1) & vStr(0)
If vStr(0) = "\" Then Err.Raise 93 'Error Pattern String
If Left(vStr(0), 1) = "\" Then Err.Raise 93
Txt = Left(Txt, Len(Txt) - 1)
Loop
If vbOpt = 0 Then
ExPaLoFi = vStr(0)
Exit Function
End If
'name
vStr(1) = ""
Do While Left(vStr(1), 1) <> "\"
vStr(1) = Right(Txt, 1) & vStr(1)
Txt = Left(Txt, Len(Txt) - 1)
If Txt = "" Then Err.Raise 93
Loop
If vbOpt = 1 Then
ExPaLoFi = Right(vStr(1), Len(vStr(1)) - 1)
Exit Function
End If
'path"
If vbOpt = 2 Then
ExPaLoFi = Txt & "\"
Exit Function
End If
'dossier
vStr(3) = ""
Do While Left(vStr(3), 1) <> "\"
vStr(3) = Right(Txt, 1) & vStr(3)
Txt = Left(Txt, Len(Txt) - 1)
If Txt = "" Then Err.Raise 93
Loop
If vbOpt = 3 Then
ExPaLoFi = Right(vStr(3), Len(vStr(3)) - 1)
Exit Function
End If
'dossier
vStr(4) = ""
Do While Left(vStr(4), 1) <> "\"
vStr(4) = Right(Txt, 1) & vStr(4)
Txt = Left(Txt, Len(Txt) - 1)
If Txt = "" Then Err.Raise 93
Loop
If vbOpt = 4 Then
ExPaLoFi = Right(vStr(4), Len(vStr(4)) - 1)
Exit Function
End If
ErrLine:
MsgBox Err.Number & Chr(10) & Err.Description & Chr(10) & "AddIn UPath.xla" & _
Chr(10) & "Function Expalofi"
End Function