PERIPHERIQUES INFO

'By JejeSoftware®
'
'Mettre dans un module
'
'
Function Pour100Libre(ByVal Total As String, ByVal Libre As String)
 Pour100Libre = Round(Libre * 100 / Total, 2) & " % libres."
End Function
Function ListeDrvs()
On Error Resume Next
    Dim T0 As String, T1 As String, T2 As String, T3 As String, T4 As String, T5 As String, Texte As String, Tail As String, Rest As String
     T1 = "0"
     T2 = "0"
     T3 = "0"
     T4 = "0"
     T5 = "0"
     Tail = "0"
     Rest = "0"
    Dim fs, d As Drive, dc, S, n
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.Drives
    For Each d In dc
     If d.DriveLetter = "A" Then GoTo Suite
     If d.DriveLetter = "B" Then GoTo Suite
     GoTo Sui
Suite:
     If d.IsReady = False Then GoTo S
Sui:
     Select Case d.DriveType
        Case 0:
         T = "Inconnu"
         T0 = T0 + 1
        Case 1:
         T = "Lecteur Amovible"
         T1 = T1 + 1
        Case 2:
         T = "Disque dur"
         T2 = T2 + 1
        Case 3:
         T = "Lecteur Réseau"
         T3 = T3 + 1
        Case 4:
         T = "Lecteur DVD-Rom ou CD-Rom ou Graveur CD-R/RW"
         T4 = T4 + 1
        Case 5:
         T = "Disque RAM"
         T5 = T5 + 1
     End Select
     If T = "Disque dur" Then Tail = Tail + Round(d.TotalSize / 1024 / 1024, 2)
     If T = "Disque dur" Then Rest = Rest + Round(d.FreeSpace / 1024 / 1024, 2)
     S = S & "Lecteur " & d.DriveLetter & ":" & vbCrLf
     S = S & "   Type : " & T & vbCrLf
     S = S & "   Nom de volume : " & d.VolumeName & vbCrLf
     S = S & "   N° de serie : " & d.SerialNumber & vbCrLf
     S = S & "   Système de fichier : " & d.FileSystem & vbCrLf
     S = S & "   Taille : " & Round(d.TotalSize / 1024 / 1024, 2) & " Mo." & vbCrLf
     S = S & "   Espace libre : " & Round(d.FreeSpace / 1024 / 1024, 2) & " Mo. soit " & Pour100Libre(d.TotalSize, d.FreeSpace) & vbCrLf
     S = S & vbCrLf
     GoTo FinSuite
S:
     S = S & "Lecteur " & d.DriveLetter & ":" & vbCrLf
     S = S & "   Type : Lecteur Amovible" & vbCrLf
     S = S & vbCrLf
     T1 = T1 + 1
FinSuite:
    Next
     If T0 = "" Then T0 = "0"
     Texte = "Périphériques :" & vbCrLf
     Texte = Texte & "  " & T0 & " Inconnu(s) " & vbCrLf & "  " & T1 & " Lecteur(s) Amovible(s) " & vbCrLf & "  " & T2 & " Disque(s) Dur(s) " & vbCrLf & "  " & T4 & " Lecteur(s) DVD-Rom ou CD-Rom ou Graveur CD-R/RW " & vbCrLf & "  " & T5 & " Disque RAM" & vbCrLf & "  " & T3 & " Lecteur(s) Réseau " & vbCrLf & vbCrLf
     Texte = Texte & " $$$ Total espace disque : " & Round(Tail / 1024, 2) & " Go. $$$" & vbCrLf & vbCrLf
     Texte = Texte & " $$$ Total espace disque restant : " & Round(Rest / 1024, 2) & " Go. soit " & Pour100Libre(Tail, Rest) & " $$$" & vbCrLf & vbCrLf
     Texte = Texte & S
   ListeDrvs = Texte
End Function
'
' Puis dans la feuille
' 
Private Sub Form_Load()
 Text1.Text = ListeDrvs
End Sub 

Télécharger le zip