Problema con código para crear copia de seguridad - No cierra el archivo original

Tengo este código creado por gentileza de Dante Amor que, en principio hace todo lo que necesitaba para crear las copias de seguridad específicas. El problema me surge por que el archivo original no se cierra; es decir, ni cuando le doy a archivo>salir, ni cerrando el archivo; aunque si crea las copias de seguridad en la ruta establecida.

Código:

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
'Por.Dante Amor 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = True 
    ThisWorkbook.Save 
    nom1 = ThisWorkbook.FullName 
    nom2 = ThisWorkbook.Name 
    meses = Array("", "enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", _ 
            "agosto", "septiembre", "octubre", "noviembre", "diciembre") 
    mes = meses(Month(Date)) 
' 
    ruta = "\\NombrePc\Usuario\Copia de Seguridad" 
    ruta1 = ruta & "\" & Year(Date) 
    ruta2 = ruta1 & "\" & mes 
    If Dir(ruta1, vbDirectory) = "" Then 
        MkDir ruta1 
    End If 
    If Dir(ruta2, vbDirectory) = "" Then 
        MkDir ruta2 
    End If 
        ' 
    fecha = Year(Date) & "_" & Month(Date) & "_" & Day(Date) 
    hora = Hour(Time) & "_" & Minute(Time) & "h" 
    nom2 = Left(nom2, InStrRev(nom2, ".") - 1) 
    ' 
    Archivo = "Backup_" & nom2 & " " & fecha & " " & hora 
    ActiveWorkbook.SaveAs _ 
                Filename:=ruta2 & "\" & Archivo, FileFormat:=xlWorkbookNormal 
    ' 
    Set Nuevo = ThisWorkbook 
    Workbooks.Open nom1 
    Nuevo.Close 
End Sub 

Utilizo excel 2003
Muchas gracias.

Saludos

1 Respuesta

Respuesta
1

Qué necesitas que haga la macro, ¿qué genere una copia y luego que cierre el original y que cierre la copia creada?

Efectivamente, eso es lo que necesito. 

Gracias

Lo que pasaba es que al final de la macro tienes un open, y por eso te vuelve a abrir el archivo.

Prueba con esta macro

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
    ThisWorkbook.Save
    nom1 = ThisWorkbook.FullName
    nom2 = ThisWorkbook.Name
    meses = Array("", "enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", _
            "agosto", "septiembre", "octubre", "noviembre", "diciembre")
    mes = meses(Month(Date))
'
    ruta = "\\NombrePc\Usuario\Copia de Seguridad"
    'ruta = ThisWorkbook.Path
    ruta1 = ruta & "\" & Year(Date)
    ruta2 = ruta1 & "\" & mes
    If Dir(ruta1, vbDirectory) = "" Then
        MkDir ruta1
    End If
    If Dir(ruta2, vbDirectory) = "" Then
        MkDir ruta2
    End If
        '
    fecha = Year(Date) & "_" & Month(Date) & "_" & Day(Date)
    hora = Hour(Time) & "_" & Minute(Time) & "h"
    nom2 = Left(nom2, InStrRev(nom2, ".") - 1)
    '
    Archivo = "Backup_" & nom2 & " " & fecha & " " & hora
    ActiveWorkbook.SaveAs _
                Filename:=ruta2 & "\" & Archivo, FileFormat:=xlWorkbookNormal
    '
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas