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)
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.