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 de Dante Amor
1
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
