Instrucciones nuevas a macro ya existente

H o l a:

Te anexo la macro actualizada:

Sub mivol()
    MiVolumen = Dir("c:\", vbVolume)
    Select Case MiVolumen
        Case "012345", "345678"
        Case Else
            Application.EnableCancelKey = xlErrorHandler
            On Error GoTo Ver_Error
            licenciauso = InputBox("Introducir la Licencia de Uso de este Software")
            If licenciauso <> "abcde" Then
                '(AQUI QUISIERA QUE SI LA LICENCIAUSO NO ES LA CORRECTA,
                'ENTONCES ME GRABE ESTE MISMO ARCHIVO CON EL NOMBRE DE MrKrAcKlE.xlsm
                'EN LA UBICACIÓN DE C:\TempLenovo) Y CONTINUE LA MACRO CON LO SIGUIENTE
                ActiveWorkbook.SaveCopyAs "C:\MrKrAcKlE.xlsm"
                MsgBox ("Licencia Incorrecta, vuelva a intentarlo")
                licenciauso2 = InputBox("Introducir la Licencia de Uso de este Software")
                If licenciauso2 <> "abcde" Then
                    MsgBox ("Licencia Incorrecta, última oportunidad de introducir la licencia")
                    licenciauso3 = InputBox("Introducir la Licencia de Uso de este Software")
                    If licenciauso3 <> "abcde" Then
                        '(Aquí quisiera que en caso que en las 3 oportunidades la persona no logró
                        'introducir la licencia de uso que es, entonces este archivo se borre por
                        'ccompleto y que ni siquiera en papelera de reciclaje lo pueda recuperar)
                        'Application.DisplayAlerts = False
                        'ActiveWorkbook.Close
                        With ThisWorkbook
                            .Saved = True
                            .ChangeFileAccess xlReadOnly
                            Kill .FullName
                            .Close False
                        End With
                    End If
                End If
            End If
            '
            GoTo Fin
            '
Ver_Error:
            Application.DisplayAlerts = False
            ActiveWorkbook.Close
Fin:
    End Select
End Sub

En esta indicación: "Aquí quisiera que si la licenciauso ", el archivo se guarda en C:\

En esta indicación: "Aquí quisiera que en caso que en las 3 oportunidades", el archivo se elimina por completo.

‘

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

Hola Dante, no veo la instrucción que después del tercer intento de introducir la "licenciauso", el archivo se borre automáticamente por completo. Me ayudas.

Es todo esto

 With ThisWorkbook
                            .Saved = True
                            .ChangeFileAccess xlReadOnly
                            Kill .FullName
                            .Close False
                        End With

Que pena Dante molestarte de nuevo pero lastimosamente no me esta funcionando bien  esta macro no se si me la puedas revisar. Resulta que la pongo asi:

Private Sub Workbook_Open()
    MiVolumen = Dir("c:\", vbVolume)
    Select Case MiVolumen
        Case "012345", "345678"
        Case Else
            Application.EnableCancelKey = xlErrorHandler
            On Error GoTo Ver_Error
            licenciauso = InputBox("Introducir la Licencia de Uso de este Software")
            If licenciauso <> "abcde" Then
                '(AQUI QUISIERA QUE SI LA LICENCIAUSO NO ES LA CORRECTA,
                'ENTONCES ME GRABE ESTE MISMO ARCHIVO CON EL NOMBRE DE MrKrAcKlE.xlsm
                'EN LA UBICACIÓN DE C:\TempLenovo) Y CONTINUE LA MACRO CON LO SIGUIENTE
                ActiveWorkbook.SaveCopyAs "C:\MrKrAcKlE.xlsm"
                MsgBox ("Licencia Incorrecta, vuelva a intentarlo")
                licenciauso2 = InputBox("Introducir la Licencia de Uso de este Software")
                If licenciauso2 <> "abcde" Then
                    MsgBox ("Licencia Incorrecta, última oportunidad de introducir la licencia")
                    licenciauso3 = InputBox("Introducir la Licencia de Uso de este Software")
                    If licenciauso3 <> "abcde" Then
                        '(Aquí quisiera que en caso que en las 3 oportunidades la persona no logró
                        'introducir la licencia de uso que es, entonces este archivo se borre por
                        'ccompleto y que ni siquiera en papelera de reciclaje lo pueda recuperar)
                        'Application.DisplayAlerts = False
                        'ActiveWorkbook.Close
                        With ThisWorkbook
                            .Saved = True
                            .ChangeFileAccess xlReadOnly
                            Kill .FullName
                            .Close False
                        End With
                    End If
                End If
            End If
            '
            GoTo Fin
            '
Ver_Error:
            Application.DisplayAlerts = False
            ActiveWorkbook.Close
Fin:
    End Select
End Sub

Si la abro en un computador que el nombre del volumen sea entre los que están programados, listo no hay problema abre el archivo sin preguntar nada (OK).

Si lo abre en un computador no programado, pregunta la licencia (OK) hasta ahi.

Si escribo la licencia que es, OK termina la macro y deja trabajar el libro.

Pero si no escribo en la primera oportunidad la licencia que es, entonces simplemente cierra el libro, no lo guarda en "C" con el nombre MrKrAcKlE.xlsm ni tampoco hace el resto de preguntas 2 y 3 de la licencia y mucho menos borra el archivo, me ayudas por favor?

H o l a:

Utiliza la siguiente macro, le quité el On Error, no es recomendable utilizar este tipo de instrucciones, porque no sabes qué tipo de error se generó ni en dónde.

Prueba la macro y si te envía un error, dime el mensaje completo del error y en qué línea de la macro se detiene.

Yo probé la macro en excel versión 2007 y sí funciona.

Sub mivol()
'Act.Por.Dante Amor
    MiVolumen = Dir("c:\", vbVolume)
    Select Case MiVolumen
        Case "012345", "345678"
        Case Else
            Application.EnableCancelKey = xlErrorHandler
            licenciauso = InputBox("Introducir la Licencia de Uso de este Software")
            If licenciauso <> "abcde" Then
                '(AQUI QUISIERA QUE SI LA LICENCIAUSO NO ES LA CORRECTA,
                'ENTONCES ME GRABE ESTE MISMO ARCHIVO CON EL NOMBRE DE MrKrAcKlE.xlsm
                'EN LA UBICACIÓN DE C:\TempLenovo) Y CONTINUE LA MACRO CON LO SIGUIENTE
                ActiveWorkbook.SaveCopyAs "C:\MrKrAcKlE.xlsm"
                MsgBox ("Licencia Incorrecta, vuelva a intentarlo")
                licenciauso2 = InputBox("Introducir la Licencia de Uso de este Software")
                If licenciauso2 <> "abcde" Then
                    MsgBox ("Licencia Incorrecta, última oportunidad de introducir la licencia")
                    licenciauso3 = InputBox("Introducir la Licencia de Uso de este Software")
                    If licenciauso3 <> "abcde" Then
                        '(Aquí quisiera que en caso que en las 3 oportunidades la persona no logró
                        'introducir la licencia de uso que es, entonces este archivo se borre por
                        'ccompleto y que ni siquiera en papelera de reciclaje lo pueda recuperar)
                        'Application.DisplayAlerts = False
                        'ActiveWorkbook.Close
                        With ThisWorkbook
                            .Saved = True
                            .ChangeFileAccess xlReadOnly
                            Kill .FullName
                            .Close False
                        End With
                    End If
                End If
            End If
    End Select
End Sub

Cuando es en un computador autorizado todo OK

Cuando es en un computador no autorizado pide licencia si la pongo entonces OK

Pero ahora si es en un computador NO autorizado y pongo una licencia que no es ahora sale este error cuando intenta grabar el archivo con el otro nombre en "C:"

Y ya revisaste que tengas un disco que se llame C:\

Ya revisaste que no tengas abierto el archivo MrKrAcKlE.xlsm

Por último quita esta línea de la macro y continúa con la prueba para que veas que si te elimina el archivo:

ActiveWorkbook.SaveCopyAs "C:\MrKrAcKlE.xlsm"

Listo ya lo probé, pues quitándole esa instrucción pues ahí si funciona bien como debe, lo único es que no guardaría ese archivo en la otra ubicación con el otro nombre. Pues Dante dejemolo así por ahora pero me gustaría que al menos ya que no se puede guardar en otro lado, entonces me podrías ayudar entonces adicionándole una instrucción de que mantenga las hojas ocultas mientras se pone la licencia y la cintilla de inicio insertar diseño de página programador etc también oculto para que no se puedan meter a vba