VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

[madine]

Bonjour à tous !

Je souhaite déposer sur une clé USB mon fichier Excel contenant mes macros ainsi que des documents annexes. Ceux ci sont classés dans des dossiers (dans la clé).

Mon objectif est d'écrire une macro me permettant d'ouvrir depuis Excel un dossier (et non un fichier en particulier) sachant que la lettre du lecteur clé USB varie d'un poste à l'autre => je ne peux donc pas indiquer un chemin d'accès stable.

Auriez vous une solution ?

Pour l'exemple : "G:\Outils\Dossier A" qui contient les fichiers que je cherche à afficher

Merci bcp !!!!!
Bonne soirée

 

[MichD]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Bonjour,


Essaie ceci :

Sub test()
Dim Chemin As String, T As String, S As Variant
Dim LecteurSource As String, A As Integer, Ok As Boolean

'***********Variable à renseigner*********
Chemin = "Outils\Dossier A\"
'*******************************************

T = RemovableDisk(LecteurSource)
If InStr(1, T, ",", vbTextCompare) > 0 Then
    S = Split(T, ",")
Else
    If Dir(T & Chemin, vbDirectory) <> "" Then
        ChDrive Left(T, 1)
        ChDir T & Chemin
        Ok = True
        MsgBox "Répertoire courant : " & T & Chemin
        Exit Sub
    Else
        MsgBox "Chemin """ & T & Chemin & _
            """ inexistant sur cette clé : " & T
        Exit Sub
    End If
End If
For A = LBound(S) To UBound(S)
    If Dir(S(A) & Chemin, vbDirectory) Then
        Application.DefaultFilePath = Dir(S(A) & Chemin)
        MsgBox "Répertoire courant : " & T & Chemin
        Ok = True
        Exit Sub
    End If
Next
If Ok = False Then
    MsgBox "Chemin """ & T & Chemin & _
        """ inexistant sur cette clé : " & T
End If
End Sub
'-------------------------------------------------------
Function RemovableDisk(MonLecteur As String)

Dim strComputer As String, objWMIService As Object
Dim Objdisk As Object, colDisks As Object

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & _
        strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
    '2 constante numérique pour disque dur "removable"
    If Objdisk.DriveType = 2 Then
        RemovableDisk = RemovableDisk & Objdisk.Name & "\" & ","
    End If
Next
If RemovableDisk <> "" Then
    RemovableDisk = Left(RemovableDisk, Len(RemovableDisk) - 1)
End If
End Function

 

[madine]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Tu es énorme ! Vraiment bravo et merci !!!

Petite question, une fois que j'ai identifié cette lettre, comment puis-je ouvrir "Outils\Dossier A" avec la bonne lettre identifiée ?

Encore merci et bonne journée !

 

[brunosc]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Bonjour.
La solution serais d'attribué une autre lettre de lecteur par exemples z ou t , comme cela les autres noms de clés ne se mélangeront pas.

 

[eriiic]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Bonjour à tous,

Autre proposition : se baser sur le nom de la clé.

Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Function GetVolumeName(ByVal cDrive As String) As String
' http://www.codyx.org/snippet_recuperer-nom-attribue-lecteur-disque-cle-etc_863.aspx
' cDrive = CHAR (lettre)  de A à Z
    Dim sBuffer As String
    Dim iEnd As Integer

    sBuffer = Space$(255)
    GetVolumeInformation cDrive & ":\", sBuffer, Len(sBuffer), 0&, 0&, 0&, vbNullString, 0&
    iEnd = InStr(1, sBuffer, vbNullChar)
    If iEnd Then GetVolumeName = Left$(sBuffer, iEnd - 1)
End Function

Function lettreLecteur(nomLecteur As String) As String
    Dim l As Long
    For l = 1 To 26
        If GetVolumeName(Chr(64 + l)) = nomLecteur Then
            lettreLecteur = Chr(l + 64)
            Exit For
        End If
    Next l
End Function

Sub test()
    Dim r As String, nomLecteur  As String
    nomLecteur = "KINGSTON"
    r = lettreLecteur(nomLecteur)
    If r <> "" Then
        MsgBox ("Lettre du lecteur '" & nomLecteur & "' = " & r)
    Else
        MsgBox ("Lecteur '" & nomLecteur & "' non trouvé.")
    End If
End Sub

eric

 

[MichD]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

comment puis-je ouvrir "Outils\Dossier A" avec la bonne lettre identifiée ?

Que veux-tu signifier par OUVRIR "Outils\Dossier A" ?

 

[madine]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

bien je souhaite ouvrir l'explorateur windows directement de ce dossier

Merci d'avance !

 

[MichD]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Voici de l'information quant à la manière de créer la ligne de code qui
te permettra d'ouvrir l'Explorateur Windows.

Désolé pour l'anglais...

Selon tes besoins, il s'agit de remplacer dans la procédure "test" que j'ai publiée
la ligne de commande qui va bien en remplaçant la ligne MSGBOX () à différents endroits
dans la macro pour afficher le chemin du répertoire courant.

Dans les exemples, tu dois adapter le chemin où se trouve le fichier "Explorer.exe" sur ton ordi.
Pour Windows 64 bits -> C:\Windows\SysWOW64 32 bits -> C:\Windows\system32

Si tu éprouves, dis-le, je reviens un peu plus tard aujourd'hui!

=========================
Syntax
EXPLORER.EXE [/n][/e][,/root,<object>]
EXPLORER.EXE [/n][/e][,/select,<object>]
Command Line Switches
/n:
Opens a new window in single-paned (My Computer) view for each item selected, even if the new window duplicates a window that is already open.
/e:
Uses Windows Explorer view (Opens a 2 pane view of the selected folder).
/root,<object>:
Specifies the root level of the specified view.
The default is to use the normal namespace root (the desktop). Whatever is specified is the root for the display.
<object> designates the folder path
This switch is used with a folder object. It chooses the designated folder as the starting point (root) of the folder tree. (Ordinarily, \DESKTOP is the root).
/select,<object>:
Specifies the folder to receive the initial focus.
If "/select" is used, the parent folder is opened and the specified object is selected. Highlights the designated folder and displays the contents of the parent folder in the right pane.
<object> designates the folder path


Examples
Ouvre Explorer ayant comme répertoire racine "Mes Documents"
À part de visionner le bureau, il est impossible de visionner la totalité du disque.
Shell "C:\winnt\EXPLORER.EXE /e,/root,c:\Mes documents"
Le "e" de la ligne de commande permet d'ouvrir l'explorateur Mode 2 plans plutot qu'un plan.

Open Explorer with Folders View to the C:\WINDOWS\TEMP folder:
C:\WINDOWS\EXPLORER.EXE /n,/e,C:\WINDOWS\TEMP
To open a Windows Explorer view to explore only objects on
\\<server name>, use the following syntax:
C:\WINDOWS\EXPLORER.EXE /e,/root,\\<server name>
To view the C:\WINDOWS folder and select NOTEPAD.EXE, use the following syntax:
C:\WINDOWS\EXPLORER.EXE /select,c:\windows\notepad.exe

 

[eriiic]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Re,

A voir ta question postée ici (au passage merci pour le doublon sans prévenir, on aime bien chercher pour rien...), avec ton fichier excel sur la clé également, tu aurais pu t'orienter vers un chemin relatif beaucoup plus simple.

eric

 

[madine]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Mes sincères remerciements à vous deux Eric et MichD !
Les deux solutions fonctionnent. La fonction alternative d'Eric, plus simple me convient finalement parfaitement car je mets mon dossier après la racine commune où se trouve le Workbook.

Encore merci !!!!

 

[david84]

Re : VBA Excel : ouvrir dossier sur clé USB (lettre du lecteur variable)

Bonjour,

le code proposé par MichD au message 2 peut planter si jamais une clé USB d'une souris sans fil est connectée au moment où vous lancez le code.
Pour faire la distinction entre les 2 types de clés la propriété DriveType ne suffit pas (d'où le plantage).
Pour y remédier vous pouvez vous servir de la propriété FreeSpace en la couplant à DriveType.
Outre le fait que vous pourrez ainsi distinguer une clé USB associée à une souris sans fil qui, d'après mes tests, n'affiche pas d'espace libre, vous pourrez également tester le fait que la clé USB ne soit pas pleine.

Donc remplacer :

If Objdisk.DriveType = 2 Then
    RemovableDisk = RemovableDisk & Objdisk.Name & "\" & ","
End If

par

If Objdisk.DriveType = 2 And Objdisk.FreeSpace > 0 Then
    RemovableDisk = RemovableDisk & Objdisk.Name & "\" & ","
End If

A+