Racine : la clé usb

Bonsoir Denis,

C'est un support de stockage. On l'utilise dans de nombreux appareils
portables (appareil photo numérique, camescope etc..). Content de
t'apprendre quelque chose! ;-)))) Ca change!

à bientôt

Greg

"Modeste" <nomail@live.fr> a écrit dans le message de groupe de discussion :
4d447f5f$0$20695$426a74cc@news.free.fr...

bonsour®

"michdenis" a écrit

Qu'est-ce une carte SD ?

;o)))
'tain je vais apprendre quelque chose à Denis !!!
http://fr.wikipedia.org/wiki/Carte_SD

Encore une fois, si ce n'est que ça, je signalerai le bug éventuel aux
utilisateurs du fichier.

"Modeste" <nomail@live.fr> a écrit dans le message de groupe de discussion :
4d447f5f$0$20695$426a74cc@news.free.fr...

bonsour®

"michdenis" a écrit

Qu'est-ce une carte SD ?

;o)))
'tain je vais apprendre quelque chose à Denis !!!
http://fr.wikipedia.org/wiki/Carte_SD

Et de cette manière, cela t'irait ?

Dans la procédure "test" , tu dois définir un répertoire
appartenant à ton lecteur amovible...pour la variable chemin

'-----------------------------------------
Sub test()
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String

'Je suppose que tu connais au moins un répertoire
'à la source de ton lecteur amovible, il s'agit que
'tu en indiques un afin de tester si le lecteur contient
'vraiment ce répertoire. Ce pourrait être une combinaison
'de répertoire comme ExcelPierreBozo si tu le désires.

'*********Variable à définir************
Chemin = "Excel"
'************************************

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
Else
If EstPret(LecteurSource) = True Then
MsgBox PathAndFile
'Ton code
Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If
End If
End Sub
'------------------------------
Function RemovableDisk(MonLecteur As String, Chemin As String)
Dim strComputer As String, A As String
Dim objWMIService As Object, colDisks As Object
Dim Objdisk As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & _
strComputer & "rootcimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
A = Objdisk.Name
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
If Dir(Objdisk.Name & "" & Chemin, vbDirectory) <> "" Then
RemovableDisk = Objdisk.Name & "" & Chemin


MonLecteur = Objdisk.Name
Exit Function
End If
End If
Next
End Function
'--------------------------------------
Function EstPret(Lecteur As String)
Dim T As Double, objFSO As Object, colDrives As Object
Dim objdrive As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
Exit Function
End If
End If
Next
End Function
'--------------------------------------




MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion : 4d448058$0$18754$426a74cc@news.free.fr...

Encore une fois, si ce n'est que ça, je signalerai le bug éventuel aux
utilisateurs du fichier.

"Modeste" <nomail@live.fr> a écrit dans le message de groupe de discussion :
4d447f5f$0$20695$426a74cc@news.free.fr...

bonsour®

"michdenis" a écrit

Qu'est-ce une carte SD ?

;o)))
'tain je vais apprendre quelque chose à Denis !!!
http://fr.wikipedia.org/wiki/Carte_SD

J'apprends beaucoup plus que tu penses à vous lire !
Ne soyez pas modeste...
;-)

MichD
--------------------------------------------

Ca a l'air de fonctionner ! J'essaie dès demain sur un autre PC pour voir
comment réagit la clé...

Merci beaucoup Denis!

"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de
discussion : ii22jf$nvj$1@speranza.aioe.org...

J'apprends beaucoup plus que tu penses à vous lire !
Ne soyez pas modeste...
;-)

MichD
--------------------------------------------

Un dernier message sur le sujet

(Enregistrer le fichier à la racine du lecteur C, sinon vouss
n'aurez pas l'occasion de voir le code..)

Fichier exemple : http://cjoint.com/?0bEbAFXHr6v

À lire, les explications données à la fin de la procédure "Private Sub Auto_Open"
sur la petite difficulté rencontrée pour enregistrer un fichier lorsque la commande
est appelée à partir d'un module qui va se supprimer !

Le code est réparti en 2 modules :

Module1 ==> Tout ce qui faut pour supprimer tout le code, formulaire et module
Module appelé "MichD" demeurera. Il contient seulement la procédure de sauvegarde
après que tout le code aura disparu.

Code du module "MichD" :

Option Explicit
'------------------------------
Sub Sauvegarde()
ThisWorkbook.Save
End Sub
'-------------------------------

Code du module1 :

Option Explicit
'-----------------------------------------
Private Sub Auto_Open()
'à l'ouverture du fichier
On Error Resume Next
'S'assurer que les références marquées manquantes
'sont décochées
Dim Refs As Object, Ref As Object
Set Refs = ThisWorkbook.VBProject.References
For Each Ref In Refs
If Ref.IsBroken = True Then
Refs.Remove Ref
End If
Next

'Ajout automatique de la référence :
'"Microsoft Visual Basic for applications Extensibility 5.3"
ThisWorkbook.VBProject.References.AddFromGuid _
"{0002E157-0000-0000-C000-000000000046}", 5, 3
DoEvents
If UCase(ThisWorkbook.Path & "") <> "C:" Then
Call Module1.TestUnprotect
'Ce module se supprime seulement après la lecture de la ligne
'de code suivante. Avant de se supprimer, cette procédure sera
'totalement complèté. La ligne de code permet à la procédure de
'finir de s'exécuter, c'est-à-dire supprimer ce module. Excel
'retient cependant en mémoire qu'il devra exécuter la procédure
'sauvegarde dans le Module Michd. À la fin de l'exécution, seul
'le module MichD demeurera, tout les autres modules, formulaires,
'code dans les modules feuilles auront été supprimés. Et le classeur
'aura été enregistré.
DoEvents
Application.OnTime (Now() + TimeValue("00:00:01")), "MichD.Sauvegarde"
End If
End Sub
'-----------------------------------------
Sub TestUnprotect()
'"a" représente le mot de passe
'Adapte le nom du module si les procédures sont dans un autre module.
Call Module1.UnprotectVBProject(ThisWorkbook, "a")
DoEvents
Call Module1.SupprimeToutCodeEtFormulaire
DoEvents
End Sub
'-----------------------------------------
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = WB.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys Password & "~~"
Application.VBE.CommandBars(1).FindControl(ID:%78, _
recursive:=True).Execute
End Sub
'-----------------------------------------
Sub SupprimeToutCodeEtFormulaire()
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = ThisWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
'Empêche le module MichD de se supprimer
If VBComp.Name <> "MichD" Then
VBComps.Remove VBComp
End If
End Select
Next VBComp
End Sub
'-----------------------------------------

MichD
--------------------------------------------

Désolé, erreur d'aiguillage.


MichD
--------------------------------------------

Bonjour Denis,

Après 2 heures d'essais en tous genres, je reviens vers toi. L'idée de
repérer le lecteur grâce à un dossier fonctionne impec. Petite remarque au
passage : les espaces ne fonctionnent pas. Il faut donc un dossier sans
esapce dans le nom. Ensuite, la petite fenêtre confirme (Sera t-il possible
de l'éviter ensuite ?) même si la fameuse carte SD est insérée. SUPER !
(m'écriais-je très tard en réveillant ma femme...)

Ensuite, dans mes nombreux essais (à peu près à l'heure où tu répondais à un
autre post sur celui-ci ;-))) ) , je pense que j'avais trouvé la
solution... Et plus moyen d'y revenir ce matin!

Voilà donc le code d'origine (travail de Daniel) suivi du tiens avec le code
incorporé. Le problème se situe à l'endroit où je rentre le chemin de
"racine". L'idée de départ étant que le premier code (qui fonctionne bien
quand on lui indique la lettre) puisse s'adapter en trouvant la clé USB.
J'ai tenté un tas de syntaxes différentes et même si j'ai dû tard dans la
nuit y parvenir, je n'y arrive plus... Voici donc les deux codes à la
suite, j'y ai fait quelques commentaires pour comprendre :

Sub RechercheFichiers()
' fonctionne impec!... mais le chemin doit être "fixe"... si la lettre
du lecteur change, c'est cuit.
racine = "I:DOSSIERSORGANISEUR" ' à modifier
Cells.Clear
Ctr = 0
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub

'-----------------------------------------
Sub test2()
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String

'Je suppose que tu connais au moins un répertoire
'à la source de ton lecteur amovible, il s'agit que
'tu en indiques un afin de tester si le lecteur contient
'vraiment ce répertoire. Ce pourrait être une combinaison
'de répertoire comme ExcelPierreBozo si tu le désires.

'*********Variable à définir************
Chemin = "DOSSIERS"
'************************************

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
Else
If EstPret(LecteurSource) = True Then
MsgBox PathAndFile

'************* début du code (Daniel) **************
racine = "I:DOSSIERSORGANISEUR" ' C'est ici qu'il faut trouver la
solution je pense!!!
Cells.Clear
Ctr = 0
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine) ' C'est ici qu'Excel propose
un déboggage
Lit_dossier dossier_racine
'************* fin du code (Daniel) **************

Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If
End If
End Sub
'------------------------------
Function RemovableDisk(MonLecteur As String, Chemin As String)
Dim strComputer As String, A As String
Dim objWMIService As Object, colDisks As Object
Dim Objdisk As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & _
strComputer & "rootcimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
A = Objdisk.Name
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
If Dir(Objdisk.Name & "" & Chemin, vbDirectory) <> "" Then
RemovableDisk = Objdisk.Name & "" & Chemin


MonLecteur = Objdisk.Name
Exit Function
End If
End If
Next
End Function
'--------------------------------------
Function EstPret(Lecteur As String)
Dim T As Double, objFSO As Object, colDrives As Object
Dim objdrive As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
Exit Function
End If
End If
Next
End Function
'--------------------------------------


Sub Lit_dossier(ByRef dossier)
Dim Decal As Integer
Decal = UBound(Split(dossier.Path, "")) - UBound(Split(racine, "")) + 1
Decal = 1 + (Decal - 1) * 2
Ctr = Ctr + 1
Cells(Ctr, Decal).Interior.ColorIndex = 6
Cells(Ctr, Decal) = dossier.Path
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal), dossier.Path,
TextToDisplay:=dossier.Name
For Each f In dossier.Files
Ctr = Ctr + 1
Cells(Ctr, Decal + 1) = f.Name
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal + 1), _
Address:=dossier.Path & "" & f.Name, _
TextToDisplay:=Left(f.Name, Len(f.Name) - 4)
Next
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub
Sub test()
Dim i As Long, Discipline2 As String, Adresse As String, Texte As String
Dim Ligne As Long, Discipline1 As String
Set sh = Sheets("SEMAINE 1")
With Sheets("Mes progressions")
For i = 2 To .Cells(Rows.Count, 5).Row
If .Cells(i, 3) <> "" Then
Discipline1 = .Cells(i, 3)
Discipline2 = ""
End If
If .Cells(i, 5) <> "" Then Discipline2 = .Cells(i, 5)
If LCase(.Cells(i, 7)) = "x" Then
If .Cells(i, 6) <> "" Then
Adresse = .Cells(i, 6).Hyperlinks(1).Address
Texte = .Cells(i, 6).Hyperlinks(1).TextToDisplay
ElseIf .Cells(i, 4) <> "" Then
Adresse = .Cells(i, 4).Hyperlinks(1).Address
Texte = .Cells(i, 4).Hyperlinks(1).TextToDisplay
Else
MsgBox "Erreur"
Exit Sub
End If
If Discipline2 = "" Then
Ligne = Application.Match(Discipline1, sh.[A:A], 0)
Else
Ligne = Application.Match(Discipline2, sh.[B:B], 0)
End If
sh.Cells(Ligne, 3).Hyperlinks.Delete
sh.Cells(Ligne, 3).ClearContents
sh.Hyperlinks.Add sh.Cells(Ligne, 3), Adresse,
TextToDisplay:=Texte
sh.Cells(Ligne, 3).Font.Color = vbBlack
sh.Cells(Ligne, 3).Font.Underline = xlUnderlineStyleNone
End If
Next i
End With
End Sub



Encore un grand merci!


Greg

"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de
discussion : ii2c24$cgv$1@speranza.aioe.org...

Désolé, erreur d'aiguillage.


MichD
--------------------------------------------

Je cherche encore ... J'ai bien lu :

A = Objdisk.Name
'2 constante numérique pour disque dur "removable"

J'ai donc essayé de remplacer mon nom de lecteur par A, mais rien n'y
fait...



"Greg" <kln@LJKnd> a écrit dans le message de groupe de discussion :
4d451d74$0$20397$426a74cc@news.free.fr...

Bonjour Denis,

Après 2 heures d'essais en tous genres, je reviens vers toi. L'idée de
repérer le lecteur grâce à un dossier fonctionne impec. Petite remarque au
passage : les espaces ne fonctionnent pas. Il faut donc un dossier sans
esapce dans le nom. Ensuite, la petite fenêtre confirme (Sera t-il
possible de l'éviter ensuite ?) même si la fameuse carte SD est insérée.
SUPER ! (m'écriais-je très tard en réveillant ma femme...)

Ensuite, dans mes nombreux essais (à peu près à l'heure où tu répondais à
un autre post sur celui-ci ;-))) ) , je pense que j'avais trouvé la
solution... Et plus moyen d'y revenir ce matin!

Voilà donc le code d'origine (travail de Daniel) suivi du tiens avec le
code incorporé. Le problème se situe à l'endroit où je rentre le chemin de
"racine". L'idée de départ étant que le premier code (qui fonctionne bien
quand on lui indique la lettre) puisse s'adapter en trouvant la clé USB.
J'ai tenté un tas de syntaxes différentes et même si j'ai dû tard dans la
nuit y parvenir, je n'y arrive plus... Voici donc les deux codes à la
suite, j'y ai fait quelques commentaires pour comprendre :

Sub RechercheFichiers()
' fonctionne impec!... mais le chemin doit être "fixe"... si la lettre
du lecteur change, c'est cuit.
racine = "I:DOSSIERSORGANISEUR" ' à modifier
Cells.Clear
Ctr = 0
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine)
Lit_dossier dossier_racine
End Sub

'-----------------------------------------
Sub test2()
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String

'Je suppose que tu connais au moins un répertoire
'à la source de ton lecteur amovible, il s'agit que
'tu en indiques un afin de tester si le lecteur contient
'vraiment ce répertoire. Ce pourrait être une combinaison
'de répertoire comme ExcelPierreBozo si tu le désires.

'*********Variable à définir************
Chemin = "DOSSIERS"
'************************************

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
Else
If EstPret(LecteurSource) = True Then
MsgBox PathAndFile

'************* début du code (Daniel) **************
racine = "I:DOSSIERSORGANISEUR" ' C'est ici qu'il faut trouver la
solution je pense!!!
Cells.Clear
Ctr = 0
'Set fso = New Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fso.getfolder(racine) ' C'est ici qu'Excel propose
un déboggage
Lit_dossier dossier_racine
'************* fin du code (Daniel) **************

Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If
End If
End Sub
'------------------------------
Function RemovableDisk(MonLecteur As String, Chemin As String)
Dim strComputer As String, A As String
Dim objWMIService As Object, colDisks As Object
Dim Objdisk As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & _
strComputer & "rootcimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
A = Objdisk.Name
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
If Dir(Objdisk.Name & "" & Chemin, vbDirectory) <> "" Then
RemovableDisk = Objdisk.Name & "" & Chemin


MonLecteur = Objdisk.Name
Exit Function
End If
End If
Next
End Function
'--------------------------------------
Function EstPret(Lecteur As String)
Dim T As Double, objFSO As Object, colDrives As Object
Dim objdrive As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
Exit Function
End If
End If
Next
End Function
'--------------------------------------


Sub Lit_dossier(ByRef dossier)
Dim Decal As Integer
Decal = UBound(Split(dossier.Path, "")) - UBound(Split(racine, "")) +
1
Decal = 1 + (Decal - 1) * 2
Ctr = Ctr + 1
Cells(Ctr, Decal).Interior.ColorIndex = 6
Cells(Ctr, Decal) = dossier.Path
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal), dossier.Path,
TextToDisplay:=dossier.Name
For Each f In dossier.Files
Ctr = Ctr + 1
Cells(Ctr, Decal + 1) = f.Name
ActiveSheet.Hyperlinks.Add Cells(Ctr, Decal + 1), _
Address:=dossier.Path & "" & f.Name, _
TextToDisplay:=Left(f.Name, Len(f.Name) - 4)
Next
For Each d In dossier.SubFolders
Lit_dossier d
Next
End Sub
Sub test()
Dim i As Long, Discipline2 As String, Adresse As String, Texte As
String
Dim Ligne As Long, Discipline1 As String
Set sh = Sheets("SEMAINE 1")
With Sheets("Mes progressions")
For i = 2 To .Cells(Rows.Count, 5).Row
If .Cells(i, 3) <> "" Then
Discipline1 = .Cells(i, 3)
Discipline2 = ""
End If
If .Cells(i, 5) <> "" Then Discipline2 = .Cells(i, 5)
If LCase(.Cells(i, 7)) = "x" Then
If .Cells(i, 6) <> "" Then
Adresse = .Cells(i, 6).Hyperlinks(1).Address
Texte = .Cells(i, 6).Hyperlinks(1).TextToDisplay
ElseIf .Cells(i, 4) <> "" Then
Adresse = .Cells(i, 4).Hyperlinks(1).Address
Texte = .Cells(i, 4).Hyperlinks(1).TextToDisplay
Else
MsgBox "Erreur"
Exit Sub
End If
If Discipline2 = "" Then
Ligne = Application.Match(Discipline1, sh.[A:A], 0)
Else
Ligne = Application.Match(Discipline2, sh.[B:B], 0)
End If
sh.Cells(Ligne, 3).Hyperlinks.Delete
sh.Cells(Ligne, 3).ClearContents
sh.Hyperlinks.Add sh.Cells(Ligne, 3), Adresse,
TextToDisplay:=Texte
sh.Cells(Ligne, 3).Font.Color = vbBlack
sh.Cells(Ligne, 3).Font.Underline = xlUnderlineStyleNone
End If
Next i
End With
End Sub



Encore un grand merci!


Greg

"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de
discussion : ii2c24$cgv$1@speranza.aioe.org...

Désolé, erreur d'aiguillage.


MichD
--------------------------------------------

Bonjour,

Mon dernier message sur le sujet, toute bonne chose doit avoir une fin !

Imagine que tu as installé plus d'une clé comme périphériques en même
temps...Comment dire à Excel qu'il a trouvé la bonne clé ? Pour les distinguer,
il s'agit de trouver une caractéristique qui est commune qu'à une clé à la fois.
Le plus simple est de demander à Excel de chercher la clé qui contient le répertoire
que l'on cherche...Cela ne résout pas le problème si plus d'une clé possède le
même répertoire et est connecté en même temps ! Il n'existe pas beaucoup d'autres
moyens de les distinguer!

Le chemin indiqué dans la procédure peut contenir des espaces et la procédure
n'est pas sensible quant à la casse de la valeur indiquée dans la variable le "Chemin".
(Windows 7)

J'ai fait le test suivant :
A ) J'ai créé un répertoire sur ma clé :
Chemin = "EXCEL 10BOZO LES CULOTTES"

B ) j'ai roulé les procédures suivantes et le résultat est éloquent.

C ) Si tu ne désires pas voir les boîtes de message s'afficher, tu
supprimes les lignes de code... elles n'étaient là que pour la
démonstration.

'------------------------------
Sub test()
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String

'Je suppose que tu connais au moins un répertoire
'à la source de ton lecteur amovible, il s'agit que
'tu en indiques un afin de tester si le lecteur contient
'vraiment ce répertoire. Ce pourrait être une combinaison
'de répertoire comme ExcelPierreBozo si tu le désires.

'*********Variable à définir************
Chemin = "EXCEL 10BOZO LES CULOTTES"
'************************************

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
Else
If EstPret(LecteurSource) = True Then
MsgBox PathAndFile
'Ton code
Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If
End If
End Sub
'------------------------------
Function RemovableDisk(MonLecteur As String, Chemin As String)
Dim strComputer As String, A As String
Dim objWMIService As Object, colDisks As Object
Dim Objdisk As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & _
strComputer & "rootcimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk")
For Each Objdisk In colDisks
A = Objdisk.Name
'2 constante numérique pour disque dur "removable"
If Objdisk.DriveType = 2 Then
If Dir(Objdisk.Name & "" & Chemin, vbDirectory) <> "" Then
RemovableDisk = Objdisk.Name & "" & Chemin
MonLecteur = Objdisk.Name
Exit Function
End If
End If
Next
End Function
'--------------------------------------
Function EstPret(Lecteur As String)
Dim T As Double, objFSO As Object, colDrives As Object
Dim objdrive As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objdrive In colDrives
If Lecteur = objdrive Then
If objdrive.IsReady = True Then
EstPret = objdrive.IsReady
Exit Function
End If
End If
Next
End Function
'--------------------------------------

MichD
--------------------------------------------