Discussion :

[Docmarti]

Comment choisir parmi les lecteurs disponibles ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub Choisir_Un_Lecteur_Disponible()
 
Lecteurs = ShowDriveList
 
t = Split(Lecteurs, vbLf)
 
LecteurChoisi = InputBox(result, "Entrez le lecteur choisi", t(UBound(t) - 1))
 
chemin = LecteurChoisi & ":\"
 
End Sub
 
Function ShowDriveList()
   Dim fso, d, dc, s, n
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set dc = fso.Drives
 
   ShowDriveList = ""
   For Each d In dc
      s = d.DriveLetter
      If d.DriveType = 3 Then
      ElseIf d.IsReady Then
         n = d.VolumeName
         ShowDriveList = ShowDriveList & d.DriveLetter & vbLf
      End If
   Next
 
End Function

[patricktoulon]

Bonsoir docmarti
je pense que ca devrait mieux marcher comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 Sub Choisir_Un_Lecteur_Disponible()
    Dim liste,monchemin
    liste = ""
    lecteurs = Split(ShowDriveList(liste), ".")
    monchemin = InputBox(liste, "choisir la cle usb", lecteurs(0) & ":\")
End Sub
Function ShowDriveList(liste)
    Dim fso, d, dc, s, n
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set dc = fso.Drives
    ShowDriveList = ""
    For Each d In dc
        If d.DriveType = 1 Then
            If d.IsReady Then
                liste = liste & "USB " & d.DriveLetter & ":" & d.VolumeName & vbCrLf
                ShowDriveList = ShowDriveList & d.DriveLetter & "."
            End If
        End If
    Next
End Function

prends la première cle dans la hérarchie

[unparia]

Bonjour
Petit test pour ceux qui, comme moi, ne laissent pas passer ce lourdaud de FSO sur leur machine

un bouton de commande (ou une macro), une listbox listbox1 et ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Sub CommandButton1_Click()
  Listbox1.Clear
  For i = 0 To 25
    If (GetLogicalDrives() And 2 ^ i) <> 0 Then
       Listbox1.AddItem Chr$(65 + i) & ":\" ' si tu veux choisir dans une listbox
    End If
  Next
End Sub

EDIT je n'ai pas inclus le lecteur A:\, réservé au lecteur de disquettes. Si on le veut également, démarrer à 64 au lieu de 65

[patricktoulon]

a oui!!! bien vu je l'avais zapé la kernel

[unparia]

Bonjour patricktoulon

J'ai choisi la librairie kernel32 car la plus rapide et élégante.
On pouvait toutefois s'en passer également, ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Listbox1.Clear
  For i = 0 To 25
    If Dir(Chr(65 + i) & ":\", vbDirectory) <> "" Then
       Listbox1.AddItem Chr$(65 + i) & ":\" ' si tu veux choisir dans une listbox
    End If
  Next

un peu moins rapide que mon code précédent mais plus rapide que FSO.

EDIT (et au passage) : une discussion a été fermée aujourd'hui (une histoire d'identification de clé USB en vue d'y écrire).
Il suffirait à ce demandeur de "marquer" sa fameuse clé par la présence, en sa racine, d'un fichier (nommé par exemple "abracadabra". Un simple dir lui permettrait alors de vérifier que sa clé usb est bien là et d'en identifier la lettre).

[patricktoulon]

oui mais on a pas les noms dans le cadre de cle usb ou disque amovible c'est important

il y a bien getlogicaldrivestring() avec kernel aussi mais je suis pas sur pour les noms j'ai divers vieux exemple mais un peu usine a gaz

[patricktoulon]

j'ai reduit a l'essentiel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Sub CommandButton1_Click()
        For i = 0 To 25
               If (GetLogicalDrives() And 2 ^ i) <> 0 Then
            lettre_disque = Chr$(65 + i) & ":\"    ' si tu veux choisir dans une listbox
            Debug.Print lettre_disque & " son nom est " & GetVolumeName(lettre_disque)
        End If
    Next
End Sub
Function GetVolumeName(ByVal cDrive As String) As String
    Dim sBuffer As String
    sBuffer = Space$(500)
    GetVolumeInformation cDrive, sBuffer, Len(sBuffer), 0&, 0&, 0&, vbNullString, 0&
    GetVolumeName = Trim(sBuffer)
End Function

EDIT (et au passage) : une discussion a été fermée aujourd'hui (une histoire d'identification de clé USB en vue d'y écrire).

je suppose que comme ca disait un truc du genre
"en fait je suis étudiant et je veux......"

ca n'a pas du plaire a un modérateur

[Docmarti]

Super. Je ne connaissais pas GetLogicalDrives et je n'avais pas pense a DIR.

Merci.

[jurassic pork]

hello,
pour avoir des infos système, ne pas oublier la possibilité d'utiliser ce "lourdaud" de WMI.

avec ce code par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Public Sub LecteursDisponibles()
Dim sWQL As String
Dim oWMISrvEx, oWMIObjSet As Object
sWQL = "Select DeviceID,Description,SystemName,FileSystem,DriveType,Mediatype From Win32_LogicalDisk"
Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
For Each oWMIObjEx In oWMIObjSet
For Each oWMIProp In oWMIObjEx.Properties_
If Not IsNull(oWMIProp.Value) Then
If IsArray(oWMIProp.Value) Then
For n = LBound(oWMIProp.Value) To UBound(oWMIProp.Value)
Debug.Print oWMIProp.Name & "(" & n & ")", oWMIProp.Value(n)
Next
Else
Debug.Print oWMIProp.Name & " : " & oWMIProp.Value
End If
End If
Next
'End If
Debug.Print "==============================="
Next
Set oWMISrvEx = Nothing
Set oWMIObjSet = Nothing
End Sub

j'obtiens ceci :

Description : Disque fixe local
DeviceID : C:
DriveType : 3
FileSystem : NTFS
MediaType : 12
SystemName : PC-LCM2
===============================
Description : Disque fixe local
DeviceID : D:
DriveType : 3
FileSystem : NTFS
MediaType : 12
SystemName : PC-LCM2
===============================
Description : Disque CD-ROM
DeviceID : E:
DriveType : 5
MediaType : 11
SystemName : PC-LCM2
===============================
Description : Disque fixe local
DeviceID : F:
DriveType : 3
FileSystem : NTFS
MediaType : 12
SystemName : PC-LCM2
===============================
Description : Disque amovible
DeviceID : W:
DriveType : 2
SystemName : PC-LCM2
===============================

Ami calmant, J.P

[Marc-L]

Bonjour,

je ne trouve pas WMI lourdaud (aucune déclaration d'API) bien au contraire comme dans cette récente discussion …

Apparemment Doc cherche juste le dernier disque :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function DernierDisque$()
    Dim oDisks As Object, oDisk As Object
    Set oDisks = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_LogicalDisk")
    For Each oDisk In oDisks:  DernierDisque = oDisk.DeviceID & "\":  Next
    Set oDisks = Nothing
End Function
 
Private Sub Choisir_Un_Lecteur_Disponible()
 
chemin = InputBox("", "Entrez le lecteur choisi", DernierDisque)
 
End Sub

[Docmarti]

Merci J.P. Interessant ton WMI.

Merci a tous.

[patricktoulon]

re
@Marc peut avoir le VolumeName avec WMI?????

j'ai rien trouvé sur ce point

[patricktoulon]

re
c'est bon j'ai trouvé au piff!!! c'est pareil qu'avec l api

"volumeName"

[Marc-L]

Salut Patrick !

En affichant les démonstrations de la discussion en lien dans mon précédent post …

[patricktoulon]

c'est bon!! j'ai trouvé tout seul , j'ai reussi a faire ce que je fait avec l'api ou le fso

dans le input tu a la liste des disque dispo dans la catégorie choisie et le dernier disque sélectionné comme ton exemple
attention les indexs de type sont différent qu'avec l'api ou le FSO

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function Disques(TpE As Long, liste) As Variant
    Dim oDisks As Object, oDisk As Object, Tp, typDisk As String
    Tp = Array(, , "USB", "disque Dur", , "DVD/CD ROM")
    If TpE <> 0 Then typDisk = "Where DriveType =" & TpE
    Set oDisks = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_LogicalDisk " & typDisk)
    For Each oDisk In oDisks: d = d & oDisk.DeviceID & "\" & vbCrLf: liste = liste & Tp(oDisk.DriveType) & "---" & oDisk.DeviceID & "\  ---" & oDisk.VolumeName & vbCrLf: Next
    Disques = Split(d, vbCrLf)
    Set oDisks = Nothing
End Function
 
Private Sub Choisir_Un_Lecteur_Disponible()
d = Disques(2, liste)          '2 pour les clefs USB ,    3 pour les autre disques ,    5 pour les dvdrom/cdrom,   0 pour tout type de disques
chemin = InputBox(liste, "Entrez le lecteur choisi", d(0))
'ou pour le dernier disque disponible dans le type precisé
'chemin = InputBox(liste, "Entrez le lecteur choisi", d(UBound(d) - 1))
 
End Sub

c'est classe non?

Attention tout de meme !!!! des l'ors que la cle fait 64 giga elle n'est pas considérer comme une cle mais un disque avec WMI
donc si on choisi 2 (usb) elle ne figure pas dans la liste
pas ce soucis avec les api