XL 2019 Modification chemin

farid · 21 Juin 2022

Bonjour,
j'ai cette macro qui fonctionne très bien.
Cependant, le chemin me pose un problème pour la raison suivante, les dossiers sont sur un disque amovible et donc la lettre de lecteur peut changer et donc par conséquent la ligne du chemin n'est plus fonctionnel .
La question est la suivante, est-ce possible d'écrire un chemin sans lettres afin que la macro puisse fonctionner sur n'importe quel lettre ?

Private Sub CommandButton4_Click()
Dim Commune As String, Chemin As String, Extension As String
Extension = ".pdf"
Chemin = "E:\Méthode\Archive-scanner\Archive scanner 2022\MR\"
Commune = Range("f11").Value2 ' Cellule contenant la commune à rechercher
ThisWorkbook.FollowHyperlink Chemin & Commune & Extension
End Sub

Par avance, merci

sylvanu · 21 Juin 2022

Bonjour Farid,
Certainement capillotractée, compliquée, peut être simplifiée, mais ça marche.
Alors en attendant mieux, une petite fonction perso :

VB:

Function TrouveLecteur(NomFichier$)
Dim fs As Object, driv As Object, N%
Set fs = CreateObject("Scripting.FileSystemObject")  'Création d'un objet FileSystemObject
If NomFichier = "" Then Exit Function
If Left(NomFichier, 1) <> "\" Then NomFichier = "\" & NomFichier ' Pour les étourdis.
For N = 65 To 90                                    ' De A à Z
    On Error Resume Next
    Disque = Chr(N) & ":"                           ' On construit A: par ex
    On Error Resume Next
    Set driv = fs.GetDrive(fs.GetDriveName(Disque))  'création d'un objet Drive auquel on affecte le lecteur
    If Not driv Is Nothing Then                     ' Si le lecteur existe
        If driv.IsReady Then                        ' S'il est prêt (média inséré)
            On Error Resume Next                    ' Si le fichier existe
            If Len(Dir(Disque & NomFichier)) > 0 Then
                TrouveLecteur = Disque              ' Retour avec lettre du lecteur
                Exit Function
            End If
        End If
    End If
Next N
End Function

Dans votre code cela donnerait :

Code:

Private Sub CommandButton4_Click()
    Dim Commune As String, Chemin As String, Extension As String
    Fichier = "\Méthode\Archive-scanner\Archive scanner 2022\MR\"
    Extension = ".pdf"
    Lettre = TrouveLecteur([C4])
    Chemin = Lettre & Fichier
    Commune = Range("f11").Value2 ' Cellule contenant la commune à rechercher
    ThisWorkbook.FollowHyperlink Chemin & Commune & Extension
End Sub

NB: Utilisez les balises </>pour le code c'est plus lisible.( à droite de l'icone GIF )

XL 2019 Modification chemin

farid

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

Discussions similaires