Fonctions fichiers (file & path)

Commenter

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

S'inscrire maintenant

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.

Du même auteur (philheiz)