Racine : la clé usb

Greg

04/02/2011 à 07:41

Bonjour et merci MichDenis,

Je teste ce matin!

"michdenis" a écrit dans le message de groupe de
discussion : iie7ol$k4d$

Sur ce fil, on parlait de vieil ordinateur... il se peut que dans certain
cas, vous deviez télécharger et installer ce fichier à cette adresse :

http://www.microsoft.com/downloads/fr-fr/details.aspx?FamilyID|219dcc-ec00-4c98-ba61-fd98467952a8

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

ristouflette

04/02/2011 à 12:30

Bonjour,

Alors, pour moi, la procédure va toujours chercher la bonne lettre sur les
ordis récents. Sur les anciens, qui buguaient, voilà ce qu'il se passe :

- une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez la
ettre du lecteur amovible"
- Quand je sélectionne la clé et que j'appuie sur OK, il me lance une
nouvelle fenêtre "aucun lecteur attaché"

Dommage, on y est presque apparemment........

"michdenis" a écrit dans le message de
news:iie571$du9$

Tu copies tout ce qui suit dans un module standard vide
et tu exécutes la procédure test.

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
If Err <> 0 Then
Err = 0
LecteurSource = X
PathAndFile = Répertoire
If X = "" Then Exit Sub
Else
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
End If
End If

If EstPret(LecteurSource) = True Then
MsgBox PathAndFile
'Ton code
Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,

"Attention."

Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

Bonjour,

Alors, pour moi, la procédure va toujours chercher la bonne lettre sur les
ordis récents. Sur les anciens, qui buguaient, voilà ce qu'il se passe :

- une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez la
ettre du lecteur amovible"
- Quand je sélectionne la clé et que j'appuie sur OK, il me lance une
nouvelle fenêtre "aucun lecteur attaché"

Dommage, on y est presque apparemment........

"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:iie571$du9$1@speranza.aioe.org...

Tu copies tout ce qui suit dans un module standard vide
et tu exécutes la procédure test.

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
If Err <> 0 Then
Err = 0
LecteurSource = X
PathAndFile = Répertoire
If X = "" Then Exit Sub
Else
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
End If
End If

If EstPret(LecteurSource) = True Then
MsgBox PathAndFile
'Ton code
Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,

"Attention."

Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,

Alors, pour moi, la procédure va toujours chercher la bonne lettre sur les
ordis récents. Sur les anciens, qui buguaient, voilà ce qu'il se passe :

- une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez la
ettre du lecteur amovible"
- Quand je sélectionne la clé et que j'appuie sur OK, il me lance une
nouvelle fenêtre "aucun lecteur attaché"

Dommage, on y est presque apparemment........

"michdenis" a écrit dans le message de
news:iie571$du9$

Tu copies tout ce qui suit dans un module standard vide
et tu exécutes la procédure test.

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

PathAndFile = RemovableDisk(LecteurSource, Chemin)
If LecteurSource = "" Then
If Err <> 0 Then
Err = 0
LecteurSource = X
PathAndFile = Répertoire
If X = "" Then Exit Sub
Else
MsgBox "Aucun lecteur amovible attaché."
Exit Sub
End If
End If

If EstPret(LecteurSource) = True Then
MsgBox PathAndFile
'Ton code
Else
MsgBox "Lecteur non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,

"Attention."

Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

michdenis

04/02/2011 à 12:55

Essaie comme ceci :

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") = vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly, "Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

Essaie comme ceci :

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") = vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly, "Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

Vous avez filtré cet utilisateur ! Consultez son message

Essaie comme ceci :

'Déclaration API dans le haut du module standard :
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "Shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolderA Lib "Shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long

'-----------------------------------------
Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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"
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") = vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly, "Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True
Resume Next

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
'-----------------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
ChoixDossier = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: ChoixDossier = ""
End If
End Function
'-----------------------------------------

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

ristouflette

04/02/2011 à 16:49

Bonsoir MichDenis,

J'avais vu ce lien ce matin, mais les machines sur lesquelles j'essaie sont
sous XP, VISTA et 2000. Donc ce patch n'est pas utile ...

Quant à cette deuxième solution, elle ne fonctionne pas mieux (essais sur 4
PC différents.) Il ne repère pas la clé... désolé

"michdenis" a écrit dans le message de
news:iie7ol$k4d$

Sur ce fil, on parlait de vieil ordinateur... il se peut que dans certain
cas, vous deviez télécharger et installer ce fichier à cette adresse :

http://www.microsoft.com/downloads/fr-fr/details.aspx?FamilyID|219dcc-ec00-4c98-ba61-fd98467952a8

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

michdenis

04/02/2011 à 17:22

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

Greg

04/02/2011 à 18:20

Bonjour à tous, et en particulier à MichDenis qui s'évertue à nous trouver
une solution!

J'ai testé les deux procédures au boulot, où il y a toutes sortes de
machines. Je fais les mêmes constats que Ristouflette. Il a plutôt bien
décrit la réponse des PC pour la première procédure. Pour la deuxième, il se
passe exactement la même chose :

"- une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez
la
ettre du lecteur amovible"
- Quand je sélectionne la clé et que j'appuie sur OK, il me lance une
nouvelle fenêtre "aucun lecteur attaché" "

J'ai fait l'essai suivant :

Je change un peu le code :

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

Une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez la
lettre du lecteur amovible", je sélectionne G: (par exemple).

Là, même réponse que Ristouflette : "aucun lecteur attaché"

Deuxième tentative :

Quand une fenêtre "Rechercher un dossier" s'ouvre et me demande
"Sélectionnez la lettre du lecteur amovible", je sélectionne G:
DOSSIERUn_autre_dossier(par exemple). Là il me dit un truc du genre : Il
n'y a pas G: DOSSIERUn_autre_dossier à l'emplacement G: DOSSIER.

Bref, c'est comme s'il ne savait pas lire ce qu'il y a sur la clé... ou
qu'il ne la reconnaissait pas du tout.

Voilà, je ne sais pas si j'apporte de l'eau au moulin. Peut-être faudrait-il
que des utilisateurs plus expérimentés que nous puissent en faire
l'expérience pour faire un retour plus pertinent....

Merci encore

Greg

"michdenis" a écrit dans le message de groupe de
discussion : iih94e$vis$

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

Bonjour à tous, et en particulier à MichDenis qui s'évertue à nous trouver
une solution!

J'ai testé les deux procédures au boulot, où il y a toutes sortes de
machines. Je fais les mêmes constats que Ristouflette. Il a plutôt bien
décrit la réponse des PC pour la première procédure. Pour la deuxième, il se
passe exactement la même chose :

"- une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez
la
ettre du lecteur amovible"
- Quand je sélectionne la clé et que j'appuie sur OK, il me lance une
nouvelle fenêtre "aucun lecteur attaché" "

J'ai fait l'essai suivant :

Je change un peu le code :

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

Une fenêtre "Rechercher un dossier" s'ouvre et me demande "Sélectionnez la
lettre du lecteur amovible", je sélectionne G: (par exemple).

Là, même réponse que Ristouflette : "aucun lecteur attaché"

Deuxième tentative :

Quand une fenêtre "Rechercher un dossier" s'ouvre et me demande
"Sélectionnez la lettre du lecteur amovible", je sélectionne G:
DOSSIERUn_autre_dossier(par exemple). Là il me dit un truc du genre : Il
n'y a pas G: DOSSIERUn_autre_dossier à l'emplacement G: DOSSIER.

Bref, c'est comme s'il ne savait pas lire ce qu'il y a sur la clé... ou
qu'il ne la reconnaissait pas du tout.

Voilà, je ne sais pas si j'apporte de l'eau au moulin. Peut-être faudrait-il
que des utilisateurs plus expérimentés que nous puissent en faire
l'expérience pour faire un retour plus pertinent....

Merci encore

Greg

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

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

Vous avez filtré cet utilisateur ! Consultez son message

isabelle

04/02/2011 à 19:20

bonjour Denis,

j'ai modifié un peu la macro Test et sur mon pc tout fonctionne
correctement, voici la modification,

Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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 = "" 'pour avoir uniquement le lecteur laisser la
variable vide ""
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") =
vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,
"Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True

MsgBox Répertoire
End Sub

isabelle

Le 2011-02-04 11:22, michdenis a écrit :

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

bonjour Denis,

j'ai modifié un peu la macro Test et sur mon pc tout fonctionne
correctement, voici la modification,

Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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 = "" 'pour avoir uniquement le lecteur laisser la
variable vide ""
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") =
vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,
"Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True

MsgBox Répertoire
End Sub

isabelle

Le 2011-02-04 11:22, michdenis a écrit :

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

Vous avez filtré cet utilisateur ! Consultez son message

bonjour Denis,

j'ai modifié un peu la macro Test et sur mon pc tout fonctionne
correctement, voici la modification,

Sub Test() 'la procédure à exécuter
Dim LecteurSource As String, Chemin As String
Dim PathAndFile As String, GestionErreur As String
Dim X As String, Ok As Boolean, Répertoire 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 = "" 'pour avoir uniquement le lecteur laisser la
variable vide ""
'************************************

On Error GoTo GestionErreur

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

If EstPret(LecteurSource) = True Then
MsgBox "Le lecteur : " & LecteurSource & "" & vbCrLf & _
"Le répertoire : " & LecteurSource & "" & Chemin

'Ton code ou appel de procédure
Else
MsgBox "Lecteur " & LecteurSource & " non disponible pour l'instant."
Exit Sub
End If

Exit Sub

GestionErreur:

Do
X = ChoixDossier
Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
If MsgBox("Le répertoire """ & Répertoire & """" & _
"n'existe pas sur le lecteur sélectionné """ & X & """." & _
vbCrLf & vbCrLf & "Désirez-vous effectuer une " & _
"autre sélection?", vbInformation + vbYesNo, "Attention") =
vbYes Then
Ok = False
Else
MsgBox "Opération annulée.", vbInformation + vbOKOnly,
"Attention."
Exit Sub
End If
Else
Ok = True
End If
Loop Until Ok = True

MsgBox Répertoire
End Sub

isabelle

Le 2011-02-04 11:22, michdenis a écrit :

| Quant à cette deuxième solution, elle ne fonctionne pas mieux

C'est ce qui est extraordinaire, c'est l'effort que tu y mets pour décrire
ce qui se passe. Il m'est difficile de tester ce qui se passe quand ça
ne fonctionne pas puisque je n'éprouve aucune difficulté.

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

michdenis

04/02/2011 à 20:45

| Deuxième tentative :

| Quand une fenêtre "Rechercher un dossier" s'ouvre et me demande
| "Sélectionnez la lettre du lecteur amovible", je sélectionne G:
| DOSSIERUn_autre_dossier(par exemple). Là il me dit un truc du genre : Il
| n'y a pas G: DOSSIERUn_autre_dossier à l'emplacement G: DOSSIER.

Suite à ton propos, j'aurais tendance à déduire que ce n'est pas la procédure
qui est en défaut mais le fait que Windows semble ne pas reconnaître le
lecteur. La question, pourquoi et comment modifier cet état de choses ?

Comme tout roule sur mon ordi, il m'est difficile d'effectuer des tests et de savoir
si ces derniers sont concluants... À cette fonction, ajouter un point d'arrêt au tout
début et utiliser la touche F8 pour exécuter chaque ligne de code. Est-ce que les
boîtes de message retournent l'information attendue ? Sinon, il faut poser l'information
aux gurus de Windows... ça ne relève plus d'un bogue de procédure...

elle remplace l'autre du même nom.
'---------------------------------
Function ChoixDossier()
Dim bInfo As BROWSEINFO, szPath As String * 512
Dim X As String, Chemin As String

'à définir selon le répertoire recherché
Chemin = "EXCEL 10"

bInfo.lpszTitle = "Sélectionnez la lettre du lecteur amovible."
bInfo.ulFlags = &H1
If SHGetPathFromIDListA(SHBrowseForFolderA(bInfo), szPath) Then
X = Left(szPath, InStr(szPath, vbNullChar) - 2)
Else: X = ""
End If

'Est-ce que la fonction retourne la lettre du lecteur
MsgBox X '<======ligne ajoutée

'Est-ce que cette ligne de code permet de savoir si le répertoire
'existe sur le lecteur

Répertoire = X & "" & Chemin
If Dir(Répertoire, vbDirectory) = "" Then
MsgBox "Impossible de lire le répertoire sur le lecteur"
Else
MsgBox "La fonction retourne le chemin correctement."
End If
ChoixDossier = X
End Function
'---------------------------------

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

michdenis

04/02/2011 à 21:14

Bonjour,

Est-ce que tu fais partie de ceux dont la toute première version
de la procédure ne fonctionnait pas correctement ?

Tu peux m'indiquer où tu as modifié la virgule ?

Merci pour eux, si tu as trouvé ce qui ne fonctionnait pas.

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

isabelle

04/02/2011 à 21:31

bonjour Denis,

j'ai pris celle de 06:55, je n'ai pas changer grand chose
- j'ai mit une chaine vide "" comme Répertoire
- j'ai enlevé Resume Next
-j'ai ajouté en toute fin MsgBox Répertoire

isabelle

Le 2011-02-04 15:14, michdenis a écrit :

Bonjour,

Est-ce que tu fais partie de ceux dont la toute première version
de la procédure ne fonctionnait pas correctement ?

Tu peux m'indiquer où tu as modifié la virgule ?

Merci pour eux, si tu as trouvé ce qui ne fonctionnait pas.

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

Racine : la clé usb

10 réponses

Veuillez sélectionner un problème