LA SOLUTION POUR LES CHEMINS ABRÉGÉS TYPE DOS

'####################################################################
'# S2L: Short to Long par Repié le 20/03/02#                        #
'###########################################                        #
'# S2L fonction qui convertit un path fomat DOS abrégé              #
'# en format Windows exploitable :)                                 #
'# j'ai fait cette fonction pour pouvoir contourner                 #
'# l'API GetFullPathName qui marchait pas chez moi qd GT en 98      #
'# le fonctionnement est simple:                                    #
'# on envoie comme paramatre le chemin court et la fonction         #
'# nous renvoie une structure contenant le nom long + à quoi        #
'# correspond le chemin (fichier ou repertoire)                     #
'# Si vous voyez des bugs (à part celui de rentrer un nom de disque)#
'# Merci de me le signaler: l__repie__l@caramail.com                #
'####################################################################


Type Retour
    Valeur As String
    Fichier As Boolean
End Type

Function S2L(temp As String) As Retour
    Dim Ret As Retour
    Dim total, result, resultb As String
    Dim c1, c2, cds
    
    temp = Replace(temp, Chr(34), "")
    'sur XP (et pe d'autres..) les " interviennent quand les
    'repertoires ont des espaces
    
    cds = 3
    'cds= compteur dernier slash on le met à 3 pour le slash du lecteur ex c:\
    
    total = Mid(temp, 1, 2)
    'on met dans total le label du lecteur
    
    For c1 = 4 To Len(temp)
        If Mid(temp, c1, 1) = "\" Then
        'on a délimité le répertoire à trouver
        
            result = Dir$(total & "\" & Mid(temp, cds + 1, c1 - cds - 1), vbDirectory Or vbHidden Or vbSystem Or vbArchive)
            'on ajoute au chemin connu le nom du repertoire à trouver
            
            If result = "" Or Not GetAttr(total & "\" & result) And vbDirectory Then S2L.Valeur = "Erreur dans le traitement": Exit Function
            'Si le retour est vide ou que le resultat n'est pas un repertoire veut dire Erreur; on sort
            
            total = total & "\" & result
            'le chemin connu s'étoffe du répertoire
            
            cds = c1
            'le dernier slash est notre position actuelle
        End If
    Next c1
    result = Dir(total & "\" & Mid(temp, cds + 1, c1 - cds - 1), vbArchive Or vbHidden Or vbSystem Or vbDirectory Or vbVolume)
    'on récupère le nom du fichier ou du répertoire
    
    If result = "" Then S2L.Valeur = "Erreur dans le traitement": Exit Function
    'si on a pas de retour: Erreur ; on sort
    total = total & "\" & result
    'on ajoute
    
    If GetAttr(total) And vbDirectory Then
    'si le "truc" qu'on a trouvé est un répertoire
        Ret.Fichier = False
    Else
    'sinon C un fichier
        Ret.Fichier = True
    End If
    Ret.Valeur = Format(total, "<")
    'on formalise le chemin en minuscule
    
    S2L = Ret
    'on en renvoie la structure
End Function
 

Télécharger le zip