Retrouver le chemin UNC à partir d'un lien hypertext qui pointe sur un fichier

Contenu du snippet

Function PathFromHyperLink(ByVal AdresseLien As String, Optional ByVal UNCPath As Boolean = False) As String
    'Renvoi le chemin complet du lien hypertext qui pointe sur un fichier
    Dim objet_fso As Object
    PathFromHyperLink = vbNullString
    'si le fichier existe
    If Not Dir(AdresseLien) = vbNullString Then
        Set objet_fso = CreateObject("Scripting.FileSystemObject")
        PathFromHyperLink = objet_fso.GetAbsolutePathName(AdresseLien)
        If UNCPath = True Then PathFromHyperLink = GetUNCPath(Replace$(PathFromHyperLink, Dir(PathFromHyperLink), vbNullString))
        Set objet_fso = Nothing
    End If
End Function
 Function GetUNCPath(ByVal MyPath As String) As String
    ' recuperation du Chemin UNC d'un lecteur reseau
    Dim Drive_fso As Object, fso As Object
    
    If MyPath = vbNullString Then Exit Function
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set Drive_fso = fso.GetDrive(fso.GetDriveName(MyPath))
    If Not Err = 0 Then
        GetUNCPath = vbNullString
    ElseIf Not Drive_fso.ShareName = vbNullString And Not LCase$(fso.GetFile(MyPath).Path) = LCase$(MyPath) Then
        GetUNCPath = Drive_fso.ShareName & Right$(MyPath, Len(MyPath) - 2)
    Else
        GetUNCPath = MyPath
    End If
    On Error GoTo 0
    Set Drive_fso = Nothing
    Set fso = Nothing
End Function
Sub demo()
    Dim Chemin As String, Macellule As Range
    Set Macellule = Range("A1")
    If Macellule.Hyperlinks.Count > 0 Then
        Chemin = PathFromHyperLink(Macellule.Hyperlinks(1).Address, True)
    End If
    If Not Chemin = vbNullString Then
        MsgBox Chemin
    End If
End Sub

Compatibilité : VBA

A voir également

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.