• Initiateur de la discussion Initiateur de la discussion gds35
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gds35

XLDnaute Impliqué
Bjr mes AMIS du Forum et bone Am ,

Voila : j'ai un disque avec des lecteurs a,c,f,g, etc et je dois sauvegarder un fichier toto que je renommerais TiTi sur un clé USB mais je ne sais quel lecteur la clé va utiliser H ou I ou ..... par contre son label est GG , comment la retrouver et fois introduite ???? Merci de votre aide GDS35
 
Re : Label d'un volume

Bonjour gds35,

je crois qu'il faut fouiller vers les FileSystemObject et les Objets Drives...

ah, voià l'exemple de l'aide VBA :

Code:
Sub AfficheListeLecteur
Dim fs, d, dc, s, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = [B]fs.Drives[/B]
For Each d in dc
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
Else
n = d.VolumeName
End If
s = s & n & vbCrLf
Next
MsgBox s
End Sub
 
Re : Label d'un volume

Salut mon AMI , ya cependant un Chimimili Blic , ji'ai les lecteur suivants : A,C,D,E,F,H (H ou est ma clé) les lecteurs D,E,F, ne sont pas Actifs ( Lecteur DVD et CD ) je tombbe en ereur "LECTEUR NON PRET ????" Que dois je faire , la solution serais de rechercher le label du volume mais comment A+ et Merci
 
Re : Label d'un volume

peut-être

Code:
Sub AfficheListeLecteur()
Dim fs, d, dc, s, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
On Error Resume Next
For Each d In dc
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
Else
n = d.VolumeName
End If
s = s & n & vbCrLf
Next
MsgBox s
End Sub
 
Re : Label d'un volume

ReSalut ton peut etre se transforme en tu as raison , maintenent je recupere bien tout les noms des labels , en copiant ton code , cependant je ne comprends pas tous les parametres fs, d, dc, s, n correspondent a quoi ??? j'aimeriq comprendre STP GRD MERCI
 
Re : Label d'un volume

Bonjour gds35, tototiti2008

Tu peux aussi essayé de trouver le disque amovible (si il n'y en a qu'un) avec ce code:

Code:
Sub recherche_lecteurs_SurFeuille()
'code adapté par MJ issu de [URL]https://www.excel-downloads.com/threads/trouver-un-fichier-sur-le-pc.14470/[/URL]
Dim FSO As Object
Dim Drv As Object
Dim Msg$
Range("G2").Select
Set FSO = CreateObject("Scripting.FileSystemObject")
Msg = "Votre système a " & FSO.Drives.Count & " lecteurs :" & vbLf & vbLf
For Each Drv In FSO.Drives
With Drv
'Stop
Select Case .DriveType
Case 0 ' unknown
Msg = Msg & "Lecteur: " & .DriveLetter & " est de type inconnu." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "type inconnu"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 1 ' removable, e.g., zip
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque amovible." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque amovible"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 2 ' fixed, hard drive
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque dur." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque dur"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 3 ' remote
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque réseau." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque réseau"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 4 ' CDROM
Msg = Msg & "Lecteur: " & .DriveLetter & " est un CDROM." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "CDROM"
 ActiveCell.Offset(1, -1).Range("A1").Select
Case 5 ' ram disk
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque virtuel." & vbLf
ActiveCell.Value = .DriveLetter & ":\"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "disque virtuel"
 ActiveCell.Offset(1, -1).Range("A1").Select
End Select
End With
Next Drv
MsgBox Msg, , "Lecteurs du système"
End Sub
 
Re : Label d'un volume

comme mis plus haut, ce code est issu de l'aide VBA, il n'est pas de moi. Ces variables désignent les objets permettant de manipuler le Système de fichier.
fs est un Objet FileSystemObject
dc est la collection des lecteurs (Drives)
d est un lecteur (Drive)
s est un texte (String) qui est affiché dans la msgbox à la fin
n est un texte qui prend soit le nom Local, soit le nom de partage (pour les lecteurs réseau) du lecteur
 
Re : Label d'un volume

Bonjour MJ13, tototiti2008 ,

Je reviens encore vers vs pour une p'tite question , d'abord vos 2 codes fonctionent a merveille , cependant comment puis-je remplacer dans le MSG
Msg = Msg & "Lecteur: " & .DriveLetter & " est un disque amovible."
"est un disque amovible" par le nom de mon unité qui est dans sa propriété "KARTONAN" ??? je cherche depuis hier pas posible de trouver.
Encore MERCI de votre Aide . GDS35
 
Re : Label d'un volume

Bonjour gds35

Pas trop compris ton
propriété "KARTONAN"

Normalement ton disque amovible doit avoir une lettre comme par exemple ton disque dur est C , ton lecteur disquette est A etc....
Donc normalement, tu dois traiter la lettre du disque amovible comme si c'était ton C sauf que tu remplaces C par la lettre du disque amovible.
 
Dernière édition:
Re : Label d'un volume

Re Salut a tous ceux qui 'ont aider dans ma demarche , je reviens cependant a vs j'ai avancé en modifiant le code de base doné par TOTOTITI208 simplement je cherche ds le code :
Sub AfficheListeLecteur()
Dim fs, d, dc, s, n
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
On Error Resume Next
For Each d In dc
s = s & d.DriveLetter & " - "
If d.DriveType = 3 Then
n = d.ShareName
Else
n = d.VolumeName
End If
s = s & n & vbCrLf
Next
MsgBox s ( REMPLACEMENT PAR UN USF avec un LABEL INCLUANT les LECTEURS ET LEUR NOM ???? COMMENT FAIRE ???? )End Sub MERCI DE M'AIDER ENCORE GDS
 
Re : Label d'un volume

Merci HASCO suis + ... que la moyenne , j'avais laissé mon code dans un module !!!!!!
suis débutant en VBA alors pardonne moi les acumulations que me done le forum elles ne sont pas encore dans ma tête entièrement. Cordialement GDS35 A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

I
Réponses
16
Affichages
5 K
safira218
S
M
Réponses
4
Affichages
2 K
M
M
Réponses
3
Affichages
4 K
_matt_44
M
S
Réponses
0
Affichages
905
S
Retour