Eres un usuario Anonimo. Haz clic aqui para entrar | Registrate

Cerrar y borrar libros

Una tarea común en Excel es abrir archivos de datos, tomar alguna información y cerrar el archivo para no abrirlo nunca más. Con el tiempo, estos archivos temporales van creciendo, a menos que los borremos meticulosamente. Este código añade una nueva opción al menú Archivo: Cerrar y Borrar. Esto permite que el libro activo se cierre y elimine. También elimina el nombre de archivo de la lista de archivos abiertos recientemente.

Sub Workbook_AddinInstall()
    Dim cmdControl As CommandBarButton
    On Error Resume Next
    Set cmdControl = Application.CommandBars(1).Controls("File").Controls(CONTROLNAME)
    If cmdControl Is Nothing Then
        Set cmdControl = Application.CommandBars(1).Controls("File").Controls.Add(Type:=msoControlButton, Before:=Application.CommandBars(1).Controls("File").Controls("Save").Index)
        With cmdControl
            .Caption = CONTROLNAME
            .FaceId = 67
            .Style = msoButtonIconAndCaption
            .DescriptionText = "Close and delete the current workbook"
            .OnAction = "CloseAndKill"
        End With
        Set cmdControl = Nothing
    End If
    On Error GoTo 0
    MsgBox "Cerrar y borrar está disponible en el menú Archivo"
End Sub
Sub Workbook_AddinUninstall()
    On Error Resume Next
    Application.CommandBars(1).Controls("File").Controls(CONTROLNAME).Delete
    MsgBox "Close and Delete is no longer available from the File Menu"
End Sub
Sub CloseAndKill()
    Dim tmpAnswer As Variant
    If ActiveWorkbook Is Nothing Then Exit Sub 
    tmpAnswer = MsgBox("Estás seguro de querer borrar " & _
        ActiveWorkbook.FullName & """?", _
        vbYesNoCancel + vbInformation)
    If tmpAnswer = vbYes Then
        Dim tmpFileName As String
        Dim RecentFle As RecentFile
        tmpFileName = ActiveWorkbook.FullName
        'esto elimina el archivo de la lista de archivos recientemente utilizados de modo que no podemos abrirlo de nuevo
        For Each RecentFle In Application.RecentFiles
            If RecentFle.Path = tmpFileName Then RecentFle.Delete
        Next
        ActiveWorkbook.Close SaveChanges:=False
        On Error Resume Next
        Kill tmpFileName 'Elimina el archivo
        If Err.Number <> 0 Then
            MsgBox "No se puede eliminar """ & tmpFileName & """."
        End If
    End If
End Sub