VBA problème code enregistrement selon nom clé usb

Bonjour à tous,

Tout d'abord bonne année, et surtout une bonne santé !

Je me tourne vers vous car j'ai un soucis dans mon code qui me sert à enregistrer une feuille de mon classeur via un bouton de commande macro. La complexité du code vient du fait que l'enregistrement de la feuille souhaitée doit se faire sur un clé usb qui porte le nom "CLÉ RÉSA" mais dont la lettre de lecteur change suivant les ordinateurs (étant amené à travailler sur plusieurs ordinateurs, j'ai opté pour un enregistrement suivant le nom de la clé et non suivant la lettre qui lui est attribuée).

Le plus étrange est que sur un ordinateur, cela marche, mais sur un autre il me fait un message d'erreur sur strComputer: "erreur de compilation, erreur ou objet introuvable". J'ai déclaré Dim strComputer as string et depuis plus d'erreur dessus mais une erreur sur objWMIService...

Voici mon code actuel:

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery _
    ("Select * from Win32_LogicalDisk")

For Each objDisk In colDisks
If objDisk.VolumeName = "CLÉ RÉSA" Then
fichier = objDisk.Caption & "\Devis\"
End If
Next

Merci de votre aide car je sèche complètement...

Cordialement,

Corsaire

Bonsoir,

Inspire-toi du code suivant et adapte-le pour ton cas :

Sub ListeLecteursAmovible()
    Dim FSO As Object
    Dim Drv As Drive
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Drv In FSO.Drives
        If Drv.Drivetype = 1 Then
            MsgBox Drv.VolumeName
        End If
    Next
End Sub

Bonsoir Raja,

Merci pour ta réponse. Cependant, j'ai toujours le même problème avec ton code, cette fois-ci le message d'erreur est le suivant:

"erreur de compilation: Projet ou bibliothèque introuvable" ...

Je ne comprends vraiment pas d'où ça peut venir ...

Re,

Donne-le code complet si possible avec le fichier.

Bonjour,

La proposition de raja revisitée ou la même qui nécessite l'ajout de la référence 'Microsoft Scripting Runtime'.

Mes meilleurs vœux pour cette nouvelle année.

Cdlt.

Option Explicit

Public Sub ListeLecteursAmovible()
Dim fso As Object, drv As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each drv In fso.Drives
        If drv.DriveType = 1 Then
            MsgBox drv.VolumeName
        End If
    Next

    Set fso = Nothing

End Sub

Public Sub DEMO()
' Menu Outils / References ---> Ajouter Microsoft Scripting Runtime
Dim fso As FileSystemObject
Dim drv As Drive

    Set fso = New FileSystemObject
    For Each drv In fso.Drives
        If drv.DriveType = 1 Then MsgBox drv.VolumeName
    Next drv

    Set fso = Nothing

End Sub