Sbloccare la protezione Bitlocker con il codice VBA

[NinoPPartecipante NinoP]

Buongiorno

`Sub SbloccaBitLocker()
    Dim LetteraUnita As String
    Dim PasswordBitLocker As String
    Dim Comando As String
    Dim WshShell As Object
    Dim Risultato As Long
  
    ' --- CONFIGURA QUI I TUOI DATI ---
    LetteraUnita = "D:"              ' Modifica con la lettera della tua unità USB
    PasswordBitLocker = "provapassword" ' Inserisci la password corretta dell'unità
    ' ---------------------------------
  
    ' Costruisce il comando PowerShell per sbloccare l'unità
    Comando = "powershell.exe -Command ""Unlock-BitLocker -MountPoint '" & LetteraUnita & "' -Password (ConvertTo-SecureString '" & PasswordBitLocker & "' -AsPlainText -Force)"""
  
    ' Crea l'oggetto per eseguire il comando con privilegi
    Set WshShell = CreateObject("WScript.Shell")
  
    ' Esegue il comando in modo invisibile (0) e attende il completamento (True)
    Risultato = WshShell.Run(Comando, 0, True)
  
    ' Verifica l'esito dell'operazione
    If Risultato = 0 Then
        MsgBox "Unità " & LetteraUnita & " sbloccata con successo!", vbInformation, "BitLocker"
    Else
        MsgBox "Errore: Impossibile sbloccare l'unità. Verifica la password, la lettera dell'unità o i privilegi di amministratore.", vbCritical, "Errore BitLocker"
    End If
  
    Set WshShell = Nothing
End Sub
`

Buongiorno a tutti gli amici del forum.
Sto perfezionando un programmino che ho creato tempo fa. In pratica, quando salvo le modifiche sul file excel che si trova fisicamente sul PC, lo stesso file va a salvarsi correttamente anche sulla chiavetta USB inserita nel PC. Da precisare che la chiavetta USB è protetta con password BITLOCKER e la devo sbloccare manualmente ogni volta che la inserisco nel PC. Ho cercato e trovato in rete dei codici, tutti teoricamente funzionanti, che dovrebbero sbloccare la protezione BITLOCKER della chiavetta USB. Il problema è che in verità l'unità dove è inserita la chiavetta (nel mio caso è l'unità "D"), continua a rimanere bloccata. Avete qualche idea su come modificare il codice che vi allego? GrazIe!

[Raffaele53Partecipante Raffaele53 Karma: 24 pts]

Non saprei e non posso provare. Trovato in rete, fai sapere se funziona.

Per sbloccare un'unità crittografata con BitLocker tramite VBA, è necessario utilizzare Windows Management Instrumentation (WMI), in particolare la classe Win32_EncryptableVolume.Per eseguire questo codice è fondamentale che Excel venga avviato come Amministratore, altrimenti il sistema bloccherà l'operazione per motivi di sicurezza.
Note importanti per il funzionamentoMetodo alternativo (Password standard): Se preferisci usare la password classica al posto della chiave di ripristino a 48 cifre, devi sostituire nel codice il metodo .UnlockWithNumericalPassword(chiaveRipristino) con .UnlockWithPassword("LaTuaPassword").Gestione degli errori: Se ricevi un errore di tipo "Accesso negato" (codice errore -2147024891 o simili), significa che Excel non ha i permessi di amministrazione elevati necessari per interagire con la sicurezza di Windows.

1) In Basso-sinistra nella casella "Cerca" Scrivi Excel ed esegui come Administrator
2) Notare ldifferenza tra "Password=stringa" ed "ChiaveRipristino=numerico"
3) Nel caso fosse la "ChiaveRipristino" con esito negativo, proverei a cambiare pure Dim chiaveRipristino As LongLong

`Option Explicit
Sub SbloccaBitLocker()
    Dim letteraUnita As String
    Dim chiaveRipristino As String
    Dim objWMIService As Object
    Dim colVolumes As Object
    Dim objVolume As Object
    Dim risultato As Long

    ' --- CONFIGURAZIONE ---
    letteraUnita = "D:"             ' Inserisci la lettera dell'unità da sbloccare
    'se lo fai fisicamente inserisci pure il trattino???
    chiaveRipristino = "123456-123456-123456-123456-123456-123456-123456-123456"  '  Inserisci la chiave di ripristino a 48 cifre
    ' ----------------------

    ' Connessione al servizio WMI con privilegi di amministratore
    On Error Resume Next
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=pktPrivacy}!\\.\root\cimv2\Security\MicrosoftVolumeEncryption")
    On Error GoTo 0

    If objWMIService Is Nothing Then
        MsgBox "Errore: Impossibile accedere a WMI. Assicurati di aver eseguito Excel come Amministratore.", vbCritical, "Errore Privilegi"
        Exit Sub
    End If

    ' Ricerca del volume specifico
    Set colVolumes = objWMIService.ExecQuery("Select * from Win32_EncryptableVolume Where DriveLetter = '" & letteraUnita & "'")

    For Each objVolume In colVolumes
        ' Tentativo di sblocco utilizzando la chiave di ripristino
        risultato = objVolume.UnlockWithNumericalPassword(chiaveRipristino)
        
        If risultato = 0 Then
            MsgBox "Unità " & letteraUnita & " sbloccata con successo!", vbInformation, "Sblocco Completato"
        Else
            MsgBox "Errore durante lo sblocco. Codice errore: " & risultato & vbCrLf & _
                   "Verifica che la chiave di ripristino sia corretta.", vbCritical, "Errore Sblocco"
        End If
        Exit Sub
    Next objVolume

    MsgBox "Unità " & letteraUnita & " non trovata.", vbExclamation, "Unità Non Trovata"
End Sub
`

[NinoPPartecipante NinoP]

Grazie Raffaele.

Ci proverò e ti farò sapere.

[NinoPPartecipante NinoP]

Buongiorno,

il codice funziona, però devo entrare come amministratore, ed è questo il problema che penso che non si possa aggirare.

Comunque grazie e ritengo risolto l'argomento.

[Raffaele53Partecipante Raffaele53 Karma: 24 pts]

Ipotesi, crea un files che tramite Sub Workbook_Open() toglie la protezione.
Tramite Private Sub Workbook_BeforeClose(Cancel As Boolean) rimetta la protezione
Salva come ON_OFF.xlsm e con diritti ADMINISTRATOR provi che funzioni il tutto

Dal Tuo files principale si può avviare ON_OFF.xlsm con diritti ADMINISTRATOR
Il problema sarebbe la comunicazione tra le due istanze d'Excel risolvibile tramite dei TXT.
Onestamente un bel casino, se desideri provarci fai sapere.

[Autore]

Articoli