Private Sub CommandButton1_Click() 'Find USB Stick Set dicUSBDrives = GetUSBDrives '--------------------------------------------------------------------------------------------------------------------------------------------------------------------- If dicUSBDrives.Count = 0 Then MsgBox "Pas trouvé de clé USB!", 48, "Chercher clé USB connectée" Else MsgBox "Trouvé une clé USB:", 64, "Chercher clé USB connectée" For Each strUSBDrive In dicUSBDrives MsgBox "Emplacement: " & strUSBDrive & "\", 64, "Chercher clé USB connectée" Target = strUSBDrive & "\MyDocuments" Next End If End Sub '--------------------------------------------------------------------------------------------------------------------------------------------------------------------- Function GetUSBDrives() ' Populate a dictionary object with USB drive letters Set dicUSBList = CreateObject("Scripting.Dictionary") dicUSBList.CompareMode = vbTextCompare strComputer = "." Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colDiskDrives = objWMI.ExecQuery("Select DeviceID from Win32_DiskDrive WHERE InterfaceType='USB'") For Each objDiskDrive In colDiskDrives strDeviceID = objDiskDrive.DeviceID strEscapedDeviceID = Replace(strDeviceID, "\", "\\") Set colDiskPartitions = objWMI.ExecQuery _ ("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & strEscapedDeviceID & """} WHERE " _ & "AssocClass = Win32_DiskDriveToDiskPartition") For Each objDiskPartition In colDiskPartitions Set colLogicalDisks = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _ objDiskPartition.DeviceID & """} WHERE " & _ "AssocClass = Win32_LogicalDiskToPartition") For Each objLogicalDisk In colLogicalDisks dicUSBList.Add objLogicalDisk.DeviceID, "" Next Next Next Set GetUSBDrives = dicUSBList End Function
Sub listeHotFixs()
Dim strComputer As String
Dim objWMIService As Object, objQuickFix As Object, colQuickFixes As
Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colQuickFixes = objWMIService.ExecQuery("Select * from
Win32_QuickFixEngineering")
For Each objQuickFix In colQuickFixes
Debug.Print "Computer: " & objQuickFix.CSName
Debug.Print "Description: " & objQuickFix.Description
Debug.Print "Hot Fix ID: " & objQuickFix.HotFixID
Debug.Print "Installation Date: " & objQuickFix.InstallDate
Debug.Print "Installed By: " & objQuickFix.InstalledBy
Next
End Sub
Dim WshShell, IdOrdinateur
Set WshShell = CreateObject("WScript.Shell" )
IdOrdinateur = WshShell.RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer\Registration\ProductId")
12 sept. 2017 à 09:33
Merci pour la promptitude de votre réponse. Malheureusement cette réponse ne correspond pas à ma demande que je précise:
Afin de "limiter" (tout est relatif!) l'installation d'un classeur excel sur une machine, j'ai basé ma protection sur la lecture de l'UUID de l'ordinateur.
Je sais le faire sur un Mac mais pas sur un PC/windows.
Je sais lire l'information sur un PC via cmd.exe par la commande "Wmic csproduct get UUID" que je cherche à intégrer dans une macro VBA mais je ne trouve pas la réponse.
Je précise que j'ai pas mal "écrémé" internet sans succès alors...
Merci à celui qui me l'apportera ou me mettra sur la bonne voie.
Bonne journée.