Discussion :

[ouskel'n'or]

Je trouve ces codes (qui fonctionnent) un peu lourds.

Code :

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

1
2
3
4
Private Sub UserForm_Initialize()
    AverDir
    Avecfso
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub AverDir()
Dim i As Byte
    CeDrv = Left(ThisWorkbook.Path, 1)
    On Error Resume Next
    For i = 65 To 91
        ChDrive Chr(i)
        DoEvents
        If Err = 0 Then
            ComboBox1.AddItem Chr(i)
        End If
        Err.Clear
    Next
    ChDrive CeDrv
End Sub

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
Sub Avecfso()
Dim drv, i As Byte
Dim fs, dr
    Set fs = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    For i = 65 To 91
        drv = Chr(i) & ":\"
        Set dr = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drv)))
        DoEvents
        If Err = 0 And _
           (dr.DriveType = 1 Or dr.DriveType = 2 Or dr.DriveType = 4) Then
            ComboBox2.AddItem dr.DriveLetter
            DoEvents
        End If
        Err.Clear
    Next
End Sub

Quelqu'un aurait-il mieux ?
Par avance, merci

[ucfoutu]

Bonjour,

ceci te conviendrait ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
 
Private Sub Command1_Click()
  Dim ousk As Long, ciuicui As Long, tesvolumes As String
    ousk = GetLogicalDrives
    tesvolumes = "tes volumes : "
    For ciuicui = 0 To 25
        If (ousk And 2 ^ ciuicui) <> 0 Then
            tesvolumes = tesvolumes & " " & Chr$(65 + ciuicui)
        End If
    Next ciuicui
    MsgBox tesvolumes
End Sub

Ah oui
Cette fonction de l'Api de Windows n'est ni du VB ni du VBA, hein ...

[ouskel'n'or]

Pas encore testé mais j'aime beaucoup la ^ cuicui.
Peux-tu m'expliquer ?
Merci
A+

[ucfoutu]

Expliquer quoi ? ciuicui (et pas cuicui) ou la fonction ?

ciuicui, c'estr parce que nous somme samedi et que le coucou (ma variable préférée) fait cuicui le samedi ...(fastoche, non ?)

La fonction ?

ben..
voilà :

La fonction GetLogicalDrives retourne un masque de bits représentant les supports (disques) disponibles.

En cas de succès : la valeur retournée est un masque de bits représentant les supports (disques) disponibles. le bit de position 0 (le moins significatf) est le disque A. Le bit de position 1 est le disque B, etc...
En cas d'échec : la valeur retournée est 0.

Déclaration :

Declare Function GetLogicalDrives Lib "kernel32" Alias "GetLogicalDrives" () As Long

Cette fonction n'utilise aucun paramètre

[ucfoutu]

Maintenant, si tu n'aimes pas l'Api de Windows (ce serait dommage) :

Voilà avec Dir (mais il faut utiliser on error Resume Next, alors.

Et on part de 66 car le "A" est réservé au lecteur de disquette...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub Command2_Click()
 Dim tesvolumes As String, I As Integer
 tesvolumes = "A"
 For I = 66 To 90
   On Error Resume Next
   If Dir(Chr(I) & ":\", vbDirectory) <> "" Then
     tesvolumes = tesvolumes & " " & Chr(I)
   End If
 Next
 MsgBox tesvolumes
End Sub

Que cherches-tu à faire ? l'équivalent pour VBA d'une DriveListBox, d'une Dirlistbox et d'une FileListBox ?
Il me semble bien que j'ai écrit celà sur ce forum (pour quelqu'un) il y a environ 6 mois ...

[pgz]

Avec la bibliothèque IWSH on accède directement à la collection des drives.

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
Sub AvecIWSH()
Dim fso As IWshRuntimeLibrary.FileSystemObject, drv As IWshRuntimeLibrary.Drive
Dim s As String
 
s = "Liste des lecteurs disponibles : " & vbCrLf
 
Set fso = New IWshRuntimeLibrary.FileSystemObject
For Each drv In fso.Drives
    s = s & "     - " & drv.DriveLetter & vbCrLf
Next drv
 
MsgBox s
 
Set fso = Nothing
End Sub

PGZ

[ucfoutu]

Bonjour, pgz,

Je n'aime pas charger FSO !

A Ousk, maintenant ...

un petit cadeau encore :

Une ListBox List1, un Textbox Text1 (apvec sa propriété multiline = True)
et un bouton de commande Command1

ce petit bout de code va te ravir

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
 
Private Sub Command1_Click()
   Dim volbuff As String
    volbuff = String(255, Chr$(0)) ' création d'un buffer pour les volumes
    GetLogicalDriveStrings 255, volbuff ' exrraction des volumes présents
    Dim i As Integer
    For i = 1 To 100
        If Left$(volbuff, InStr(1, volbuff, Chr$(0))) = Chr$(0) Then Exit For
        ' extraction des volumes & de leur nature
        Text1.Text = Text1.Text & Left$(volbuff, InStr(1, volbuff, Chr$(0)) - 1) & " " & _
        voyons_affichons(Left$(volbuff, InStr(1, volbuff, Chr$(0)) - 1)) & vbCrLf
        volbuff = Right$(volbuff, Len(volbuff) - InStr(1, volbuff, Chr$(0)))
        voyons_disque Left$(volbuff, InStr(1, volbuff, Chr$(0)) - 1)
    Next i
End Sub
 
Private Function voyons_affichons(disque As String)
    Dim toto As String
    Select Case GetDriveType(disque)
        Case 2
            toto = " (disque ammovible)"
        Case 3
            toto = " (disque fixe)"
        Case Is = 4
            toto = " (disque distant)"
        Case Is = 5
            toto = " (Cd-Rom)"
        Case Is = 6
            toto = " (disque Ram)"
        Case Else
            toto = " (inexistant ou non reconnu)"
    End Select
    voyons_affichons = toto
End Function
 
Private Sub voyons_disque(disque As String)
    Dim Sectors As Long, Bytes As Long, FreeC As Long, TotalC As Long, Total As Long, Freeb As Double
    GetDiskFreeSpace disque, Sectors, Bytes, FreeC, TotalC ' extractions des informations/disque
    If disque = "" Then Exit Sub
    List1.AddItem " Path: " & disque
    List1.AddItem " Sectors per Cluster:" & Str(Sectors)
    List1.AddItem " Bytes per sector:" & Str(Bytes)
    List1.AddItem " Number Of Free Clusters:" & Str(FreeC)
    List1.AddItem " Total Number Of Clusters:" & Str(TotalC)
    Dim totc As Double, frc As Double
    totc = TotalC / 1000000000 'on veut afficher des gigaoctets
    totc = totc * Sectors * Bytes
    List1.AddItem "Nombre total d'octets : " & Str$(totc) & " gigaoctets"
    frc = FreeC / 1000000000 'on veut afficher des gigaoctets
    Freeb = frc * Sectors * Bytes
    List1.AddItem " Nombre d'octets libres :" & Str$(Freeb) & " gigaoctets"
    List1.AddItem ""
    List1.AddItem "=================="
    List1.AddItem ""
End Sub

[ouskel'n'or]

Ce qui revient au même que celui que j'ai mis dans mon premier post.
Mais

Et on part de 66 car le "A" est réservé au lecteur de disquette...

Sauf que je pars de 65 car si l'on cherche un fichier, il peut aussi bien être sur une disquette... (j'en ai encore où j'ai des vieilles appli VB4 ou 5, alors si un jour je veux les retrouver, tu comprends... )
Mais merci pour tes explications, il y a tellement longtemps que je n'ai pas utilisé le binaire que sans ton secours je n'aurais jamais trouvé.
Bref, sans cuicui y'a pas d'espoir
Bon, ben je ferai avec. Mais je crois que je vais utiliser cuicui ou fso, là je comprends ce que je fais et les gestions d'erreur, si je peux éviter...
Merci pour tes lumières.
Bon week-end

[pgz]

Bonjour ucfoutu.

Qu'est-ce qui te dérange dans l'idée d'instancier le fso?
Tu y vois une grande différence pratique avec l'utilisation d'API?

A +,

PGZ

[ucfoutu]

L'utilisation de l'Api ne charge rien (FSO, oui... et il utilise ensuite lui-même l'API !!!)

Même VBA utilise l'API ...

Utiliser l'API, c'est rendre ton appli beaucoup plus rapide et, surtout, indépendante.

[ouskel'n'or]

Edit
Cuicui et fso sont aussi rapides l'un que l'autre, Dir, c'est une charrue dans ce contexte.

Editbis
Dans fso, j'ai une gestion d'horreurs... Ce sera donc cuicui ! ucfoutu content !

Editter
Merci pgz, je n'avais pas vu ta réponse

Avec la bibliothèque IWSH on accède directement à la collection des drives.

Malheureusement, avec cette solution il est nécessaire valider la référence et c'est ce que j'évite au maximum de faire.
Je crois que je vais en rester à la solution proposée par ucfoutu.

En l'honneur de ucfoutu, c'est devenu ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
 
Private Sub CommandButton1_Click()
  Dim uc As Long, foutu As Long
    uc = GetLogicalDrives
    For foutu = 0 To 25
        If (uc And 2 ^ foutu) <> 0 Then _
            Me.Listbox2.additem Chr$(65 + foutu)
    Next
End Sub

................................................................

[Michel_M]

Bonjour à tous,

Autre manière avec WMI

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub enumerer_memoiresmasse()
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk")
For Each objdisk In colDisks
    MsgBox "Nom: " & objdisk.Name & " " & objdisk.Description _
    & vbCr & "Taille: " & objdisk.Size & "  octets; dont espace libre: " & objdisk.FreeSpace & " octets"
 Next
End Sub

d'après script vbs sur ADSI