Безопасное извлечение устройства, не удаляя букву диска

' Извлечение диска (USB или CD/DVD), при этом буква диска остаётся (только для Win 7)
Public Sub EjectDriveWMI(DriveLetter As String)
    Dim Obj As Object
    
    Set Obj = CreateObject("Shell.Application")
    
    Obj.Namespace(ssfDRIVES).ParseName(DriveLetter + ":\").InvokeVerb ("Eject")
    
    Set Obj = Nothing
End Sub

Option Explicit
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = &H2D4808
Private Const IOCTL_STORAGE_LOAD_MEDIA = &H2D480C
 
Private Type OVERLAPPED
    Internal As Long
    InternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type
 
' Извлечение диска (USB или CD/DVD), при этом буква диска остаётся (для всех версий Windows)
Public Sub EjectDrive(DriveLetter As String)
    Dim hDrive As Long
    Dim DummyReturnedBytes As Long
    Dim ol As OVERLAPPED
    
    hDrive = CreateFile("\\.\" & DriveLetter & ":", GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
    
    If hDrive <> INVALID_HANDLE_VALUE Then
        Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ol)
        Call CloseHandle(hDrive)
    End If
End Sub
 
' Загрузка диска (USB или CD/DVD)
Public Sub LoadDrive(DriveLetter As String)
    Dim hDrive As Long
    Dim DummyReturnedBytes As Long
    Dim ol As OVERLAPPED
    
    hDrive = CreateFile("\\.\" & DriveLetter & ":", GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
    
    If hDrive <> INVALID_HANDLE_VALUE Then
        Call DeviceIoControl(hDrive, IOCTL_STORAGE_LOAD_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ol)
        Call CloseHandle(hDrive)
    End If
End Sub
 
Private Sub Command1_Click()
    EjectDrive Mid$(Drive1.Drive, 1, 1) ' Только буква
End Sub
 
Private Sub Command2_Click()
    LoadDrive Mid$(Drive1.Drive, 1, 1) ' Только буква
End Sub

Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)