VBA: obtenir l'adresse réseau d'un fichier (UNC)

L'expansion des "clouds", "nuages" et les lecteurs partagés et/ou en réseau nécessite une approche plus moderne de gérer les fichiers. C'est pour cela que je vous propose deux fonctions VBA qui permettent d'identifier de manière unique l'adresse réseau d'un lecteur ou d'un fichier (selon UNC – Universal Naming Convention)…

Habituellement, nous utilisons les noms de lecteurs C:\, D:\ etc. Il s'agit, en principe, des disques durs locaux. Et pour se faciliter la vie (pour faire plus court et pour rendre plus lisible), on "mappe" les lecteurs réseau à une lettre également. Ainsi, plutôt que \\mon.serveur.fr\Dossier\SousDossier\ , vous préférerez probablement Z:\ .

Mais ceci peut vous amener au problème suivant: vous écrivez une macro qui utilise un certain fichier qui est placé sur le réseau qui est "mappé" sur votre machine comme H:\. Vous utilisez donc dans votre code des instructions comme Dir("H:\MonDossier\MonFichier.txt")… Tout marche bien. Vous enverrez la macro à votre collègue et là… Plus rien… Pourquoi? Peut-être parce que votre collègue a nommé (mappé), sur sa machine, le lecteur réseau en question J:\ et pas H:\ comme vous… Le disque existe, le fichier également et pourtant, la macro ne marchera pas…

Heureusement, vous pouvez utiliser le code qui suit pour retrouver l'adresse unique du lecteur ou du fichier…

Code VBA pour trouver l'adresse réseau d'un disque

La fonction VBA qui suit retourne l'adresse réseau du lecteur qui est passé à la fonction en tant qu'argument unique de cette fonction. La fonction s'attend au nom du lecteur dans le format X: ou X:\ .

Si le nom de lecteur ne correspond pas à ce format, la fonction va retourner l'erreur #VALUE!.
Si le lecteur n'existe pas ou il ne s'agit pas d'un lecteur réseau, la fonction va retourner l'erreur #N/A. Vous pouvez le tester par exemple avec le disque C:\…

Function AdresseLecteur(ByVal NomDeLecteur As String)
'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo CheminReseauError
    Dim ObjetReseau  As Object
    Dim ObjetLecteurs  As Object
    Dim CompteurLecteurss    As Long

    Set ObjetReseau = CreateObject("WScript.Network")
    Set ObjetLecteurs = ObjetReseau.EnumNetworkDrives
    
    'correction de l'input si nécessaire
    If Right(NomDeLecteur, 1) = "\" Then NomDeLecteur = Left(NomDeLecteur, Len(NomDeLecteur) - 1)
    If Len(NomDeLecteur) > 2 Then
        AdresseLecteur = CVErr(xlErrValue)
        Exit Function
    Else
    End If
    
    'recherche d'ardesse réseau
    For CompteurLecteurs = 0 To ObjetLecteurs.Count - 1 Step 2
        If UCase(ObjetLecteurs.Item(CompteurLecteurs)) = UCase(NomDeLecteur) Then
            AdresseLecteur = ObjetDisques.Item(CompteurLecteurs + 1)
            Exit For
        End If
    Next
    
    If AdresseLecteur = "" Then AdresseLecteur = CVErr(xlErrNA)
Exit Function

CheminReseauError:
AdresseLecteur = CVErr(xlErrValue)
End Function

Function AdresseLecteur(ByVal NomDeLecteur As String)

'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo CheminReseauError

Dim ObjetReseau As Object

Dim ObjetLecteurs As Object

Dim CompteurLecteurss As Long

Set ObjetReseau = CreateObject("WScript.Network")

Set ObjetLecteurs = ObjetReseau.EnumNetworkDrives

'correction de l'input si nécessaire

If Right(NomDeLecteur, 1) = "\" Then NomDeLecteur = Left(NomDeLecteur, Len(NomDeLecteur) - 1)

If Len(NomDeLecteur) > 2 Then

AdresseLecteur = CVErr(xlErrValue)

Exit Function

Else

End If

'recherche d'ardesse réseau

For CompteurLecteurs = 0 To ObjetLecteurs.Count - 1 Step 2

If UCase(ObjetLecteurs.Item(CompteurLecteurs)) = UCase(NomDeLecteur) Then

AdresseLecteur = ObjetDisques.Item(CompteurLecteurs + 1)

Exit For

End If

If AdresseLecteur = "" Then AdresseLecteur = CVErr(xlErrNA)

Exit Function

CheminReseauError:

AdresseLecteur = CVErr(xlErrValue)

End Function

Exemple d'utilisation

Et voici une simple procédure VBA (Sub) avec un exemple d'utilisation de cette fonction…

Sub ExempleAdresseReseauLecteur()
'par: Excel-Malin.com ( https://excel-malin.com )
Dim MonLecteur As String

MsgBox AdresseLecteur("J:")
'ou
MonLecteur = "H:"
MsgBox AdresseLecteur(MonLecteur)

End Sub

Sub ExempleAdresseReseauLecteur()

'par: Excel-Malin.com ( https://excel-malin.com )

Dim MonLecteur As String

MsgBox AdresseLecteur("J:")

'ou

MonLecteur = "H:"

MsgBox AdresseLecteur(MonLecteur)

End Sub

Code VBA pour trouver l'adresse réseau d'un fichier

Cette deuxième fonction est un dérivé de la fonction précédente: en plus du renvoi de l'adresse du lecteur réseau, elle remplace le nom mappé du lecteur par son adresse réseau dans un nom & chemin d'un fichier. En gros: vous mettez dans l'argument le chemin complet d'un fichier avec son nom de lecteur mappé et la fonction va retourner le chemin complet mais avec l'adresse réseau du lecteur…

Attention: cette fonction ne vérifie pas si le fichier existe! Elle ne fait que rendre le chemin "unique". Si vous voulez, vous pouvez combiner cette fonction avec la fonction VBA qui vérifie si le fichier existe.

Function AdresseReseauDuFichier(ByVal CheminLocalDuFichier As String)
'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo AdresseReseauError
    Dim ObjetReseau  As Object
    Dim ObjetLecteurs  As Object
    Dim CompteurLecteurs    As Long
    Dim LecteurNom As String
    
    LecteurNom = Left(CheminLocalDuFichier, 2)
    If Right(LecteurNom, 1) <> ":" Then 'si le CheminLocalDeFichier ne pointe pas vers un disque local
        AdresseReseauDuFichier = CVErr(xlErrNA)
        Exit Function
    Else
    End If

    Set ObjetReseau = CreateObject("WScript.Network")
    Set ObjetLecteurs = ObjetReseau.EnumNetworkDrives

    For CompteurLecteurs = 0 To ObjetLecteurs.Count - 1 Step 2
        If UCase(ObjetLecteurs.Item(CompteurLecteurs)) = UCase(LecteurNom) Then
            AdresseReseauDuFichier = Replace(CheminLocalDuFichier, LecteurNom, ObjetLecteurs.Item(CompteurLecteurs + 1))
            Exit For
        End If
    Next
Exit Function

AdresseReseauError:
AdresseReseauDuFichier = CVErr(xlErrNA)
End Function

Function AdresseReseauDuFichier(ByVal CheminLocalDuFichier As String)

'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo AdresseReseauError

Dim ObjetReseau As Object

Dim ObjetLecteurs As Object

Dim CompteurLecteurs As Long

Dim LecteurNom As String

LecteurNom = Left(CheminLocalDuFichier, 2)

If Right(LecteurNom, 1) <> ":" Then 'si le CheminLocalDeFichier ne pointe pas vers un disque local

AdresseReseauDuFichier = CVErr(xlErrNA)

Exit Function

Else

End If

Set ObjetReseau = CreateObject("WScript.Network")

Set ObjetLecteurs = ObjetReseau.EnumNetworkDrives

For CompteurLecteurs = 0 To ObjetLecteurs.Count - 1 Step 2

If UCase(ObjetLecteurs.Item(CompteurLecteurs)) = UCase(LecteurNom) Then

AdresseReseauDuFichier = Replace(CheminLocalDuFichier, LecteurNom, ObjetLecteurs.Item(CompteurLecteurs + 1))

Exit For

End If

Exit Function

AdresseReseauError:

AdresseReseauDuFichier = CVErr(xlErrNA)

End Function

Exemple d'utilisation

Et voici à nouveau un exemple d'utilisation de cette fonction… Plutôt simple 🙂

Sub ExempleAdresseReseauDuFichier()
'par: Excel-Malin.com ( https://excel-malin.com )

Dim MonFichier As String

MsgBox AdresseReseauDuFichier("J:\Temp\ABC\FicheProduit_ABC.pdf")
'ou
MonFichier = "H:\Documents\Marketing\2022\10\Rapport_2127845.docx"
MsgBox AdresseReseauDuFichier(MonFichier)

End Sub

Sub ExempleAdresseReseauDuFichier()

'par: Excel-Malin.com ( https://excel-malin.com )

Dim MonFichier As String

MsgBox AdresseReseauDuFichier("J:\Temp\ABC\FicheProduit_ABC.pdf")

'ou

MonFichier = "H:\Documents\Marketing\2022\10\Rapport_2127845.docx"

MsgBox AdresseReseauDuFichier(MonFichier)

End Sub

Conclusion

Voici donc les functions qui vous permettront d'éviter des erreurs et de rendre votre projet VBA plus robuste dans le cas où vous travaillez avec des fichiers ou dossiers qui se trouvent sur un/des lecteur(s) en réseau.

N'hésitez pas à partager vos remarques, suggestions ou questions dans les commentaires.

Pour aller plus loin en VBA…

Et voici quelques liens qui pourraient vous être utils dans votre programmation en VBA…

Cours VBA en ligne: "VBA: droit au but"
VBA et SharePoint
E-book de Excel-Malin.com: Référentiel VBA (avec toutes les fonctions, instructions, événements et opérateurs)
Comment utiliser RECHERCHEV en VBA
Protéger votre code VBA par un mot de passe
Débloquer VBA dans les fichiers XLSM en provenance d'Internet

VBA: obtenir l’adresse réseau d’un fichier (UNC)

Code VBA pour trouver l'adresse réseau d'un disque

Exemple d'utilisation

Code VBA pour trouver l'adresse réseau d'un fichier

Exemple d'utilisation

Conclusion

Pour aller plus loin en VBA…

Auteur

Martin Hudec ( Excel-Malin.com )

Laissez un commentaire Annuler la réponse

Commentaire sur “VBA: obtenir l’adresse réseau d’un fichier (UNC)”