Fonctions fichiers (file & path)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 790 fois - Téléchargée 33 fois

Contenu du snippet

Les fonctions suivantes sont assez utiles lorsqu'il s'agit de travailler avec des noms de fichiers.

Source / Exemple :


Option Explicit

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function PathRelativePathTo Lib "shlwapi.dll" Alias "PathRelativePathToA" (ByVal pszPath As String, ByVal pszFrom As String, ByVal dwAttrFrom As Long, ByVal pszTo As String, ByVal dwAttrTo As Long) As Long
Private Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long
Private Declare Function PathCanonicalize Lib "shlwapi.dll" Alias "PathCanonicalizeA" (ByVal pszBuf As String, ByVal pszPath As String) As Long
Private Const MAX_PATH As Long = 260
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80

Function GetFileExtention(sFileName As String, _
    Optional WithDot As Boolean) As String
    Dim i As Long
    i = InStrRev(sFileName, ".")
    If i = 0 Then GoTo CLEAN_EXIT
    GetFileExtention = Mid$(sFileName, i + IIf(WithDot, 0, 1))
CLEAN_EXIT:
End Function

Function GetFileFolder(LongFileName As String, _
    Optional PathSeparator As Boolean) As String
    Dim a As Long
    Dim b As Long
    b = InStrRev(LongFileName, "\") - 1
    If b <= 0 Then GoTo CLEAN_EXIT
    a = InStrRev(LongFileName, "\", b) + 1
    GetFileFolder = Mid$(LongFileName, a, b - a + 1) & IIf(PathSeparator, "\", "")
CLEAN_EXIT:
End Function

Function GetFileName(LongFileName As String, _
    Optional RemoveExtention As Boolean) As String
    ' get file name (find last '\')
    GetFileName = LongFileName
    Dim i As Long
    i = InStrRev(LongFileName, "\")
'    If i = 0 Then GoTo CLEAN_EXIT
    GetFileName = Mid$(LongFileName, i + 1)
    ' remove extention (find last '.')
    If Not RemoveExtention Then GoTo CLEAN_EXIT
    i = InStrRev(GetFileName, ".") - 1
    If i <= 0 Then GoTo CLEAN_EXIT
    GetFileName = Left$(GetFileName, i)
CLEAN_EXIT:
End Function

Function GetFilePath(LongFileName As String, _
    Optional PathSeparator As Boolean) As String
    Dim i As Long
    i = InStrRev(LongFileName, "\") - IIf(PathSeparator, 0, 1)
    If i <= 0 Then GoTo CLEAN_EXIT
    GetFilePath = Left$(LongFileName, i)
CLEAN_EXIT:
End Function

Function GetUNCPath(ByVal sPath As String) As String
    ' >> Universal Naming Convention << (\\SERVER\...)
    ' http://www.microsys-kramer.de/tipps/uncpfad_ermitteln.php
    Const NO_ERROR  As Long = 0
    Dim sUNCPath    As String
    Dim sResult     As String
    Dim sDrive      As String
    GetUNCPath = sPath
    If VBA.Mid$(sPath, 2, 1) <> ":" Then GoTo CLEAN_EXIT
    sDrive = VBA.Left$(sPath, 2)
    sUNCPath = VBA.String(260, 0)
    If WNetGetConnection(sDrive, sUNCPath, VBA.Len(sUNCPath)) = NO_ERROR Then
        sResult = _
        VBA.Left$(sUNCPath, VBA.InStr(sUNCPath, vbNullChar) - 1)
        If VBA.Len(sResult) > 0 Then
            GetUNCPath = sResult & VBA.Mid$(sPath, 3)
        End If
    End If
CLEAN_EXIT:
End Function

Public Function RelativePath(ByVal parent_path As String, ByVal child_path As String) As String
    Dim sRet    As String
    Dim sParent As String
    Dim sChild  As String
    Dim iZero   As Long
    sRet = String(MAX_PATH, 0)
    sParent = GetUNCPath(parent_path) + String(100, 0)
    sChild = GetUNCPath(child_path) + String(100, 0)
    Call PathRelativePathTo(sRet, sParent, FILE_ATTRIBUTE_DIRECTORY, sChild, FILE_ATTRIBUTE_NORMAL)
    iZero = InStr(1, sRet, Chr$(0))
    If iZero > 0 Then sRet = Left$(sRet, iZero - 1)
    RelativePath = sRet
End Function

Public Function AbsolutePath(ByVal relative_path As String, Optional base_path As String) As String
    AbsolutePath = relative_path
    If Not CBool(PathIsRelative(relative_path)) Then Exit Function
    Dim sBase As String
    Dim sRet  As String
    Dim iZero   As Long
    sRet = String(MAX_PATH, 0)
    If Trim$(base_path) = "" Then sBase = App.Path
    sBase = GetFilePath(sBase, True)
    Call PathCanonicalize(sRet, sBase & relative_path)
    iZero = InStr(1, sRet, Chr$(0))
    If iZero > 0 Then sRet = Left$(sRet, iZero - 1)
    AbsolutePath = sRet
End Function

Conclusion :


GetFileExtention: retourne l'extention d'un fichier.
GetFileFolder: retourne le dossier du fichier.
GetFileName: retourne le nom, sans chemin, d'un fichier.
GetFilePath: retourne le chemin du fichier.
GetUNCPath: retourne le chemin au format UNC (\\SERVER\...)
RelativePath: retourne un chemin relatif (.\..\z)
AbsolutePath: retourne un chemin fixe (c:\x\y\z)

A voir également

Ajouter un commentaire

Commentaires

Messages postés
98
Date d'inscription
lundi 17 novembre 2008
Statut
Membre
Dernière intervention
4 septembre 2012

merci beaucoup pour cette source, jen avais beaucoup besoin pour mon projet
je vais mettre une bonne note
a+
Messages postés
2336
Date d'inscription
samedi 14 juillet 2001
Statut
Membre
Dernière intervention
5 mai 2009
4
ouin, je parlais plus de ça

Function GetFileExtention(sFileName As String, _
Optional WithDot As Boolean) As String
Dim i As Long
i = InStrRev(sFileName, ".")
If i <> 0 Then GetFileExtention = Mid$(sFileName, i + IIf(WithDot, 0, 1))
end if
End Function
Messages postés
117
Date d'inscription
mercredi 3 décembre 2003
Statut
Membre
Dernière intervention
11 octobre 2007
1
t'as raison !
je mets à jour.
Messages postés
2336
Date d'inscription
samedi 14 juillet 2001
Statut
Membre
Dernière intervention
5 mai 2009
4
dur d'amélioreer les vitesse, masi pour uen bonne programation, évite les exit function au plus possible

mieux vaut des if else end if que sortir de la fonction.

c'est seulement plus facile de déboggué un programme quand il y a pas d'exit.

c'est sur que pour des petite fonction comme ça, ça change pas grand chose, mais quand tu es rendu a avoir des méthode qui prennent plusieurs page (à éviter, mais quand on débogue c est presque juste ça) ça prend plus de temps a comprendre a 100% la méhode, puisqu'il faut toujuors remonter dans le code voir ou ca sort.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.