DominoArea.org [Archive]

[syntax="LotusScript"]Public Function FileSeparate (wPathFile As String,nbSeparateExtention As Integer) As Variant

'renvoi le chemin et le nom du fichier séparement ainsi que le le nom du fiçchier et son extension

'Déclaration des Variables
Dim lstFile List As String
Dim Text As String
Dim i As Integer

On Error Goto ErreurHandle

lstFile("PATH") = ""
lstFile("FILE") = ""
If nbSeparateExtention = True Then
lstFile("NAME") = ""
lstFile("EXT") = ""
End If

If Trim(wPathFile) = "" Then
FileSeparate =""
Exit Function
End If

'Separe le fichier du répertoire

i = Len(wPathFile)

While Trim(Text)<>"\"
Text = Mid(wPathFile,i,1)
If Trim(Text)<>"\" Then
i = i-1
If i = 0 Then
Text = "\"
End If
End If
Wend

If i = 0 Then
lstFile("FILE") = Trim(wPathFile)
Else
lstFile("PATH") = Left(Trim(wPathFile),i)
lstFile("FILE") = Right(Trim(wPathFile),(Len(wPathFile)-i))
End If

' separe l'extention et le nom du fichier
If nbSeparateExtention = True Then
If Trim(lstFile("FILE"))<>"" Then
Text = Trim(lstFile("FILE"))
For i=Len(Text) To 1 Step -1
If Mid(Text ,i,1) = "." Then
lstFile("EXT") = Trim(Right(Text,Len(Text)-i))
End If
Next
If Trim(lstFile("EXT"))<>"" Then
Text = Trim(lstFile("FILE"))
lstFile("NAME") = Left(Text ,Len(Text )-Len("."+Trim(lstFile("EXT"))))
End If
End If
End If

FileSeparate = lstFile

Erase lstFile

Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstFile
lstFile("PATH") = ""
lstFile("FILE") = ""
If nbSeparateExtention = True Then
lstFile("NAME") = ""
lstFile("EXTENSION") = ""
End If
FileSeparate = lstFile
Erase lstFile
Exit Function
End Function[/syntax]