Crear respaldo de libro con nombre de fecha y en escritorio.
Tengo este código:
Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim Resp As BooleanResp = FalseResp = IIf(MsgBox("Desea Guardar una Copia?", _vbQuestion + vbYesNo, "Atención") = vbYes, True, False)If Resp ThenApplication.Dialogs(xlDialogSaveAs).ShowEnd IfEnd Subel cual me guarda una copia de mi libro antes de cerrar por completo..
Lo que requiero es que antes de cerrar mi libro original:
1 - se guarde en el escritorio con el nombre de mi libro original + la fecha de hoy() o el nombre de mi libro original y algo que indentifique que es un respaldo
Ejemplo: libro original " reportes"
Respaldo "reportes 13032015" o "reportes respaldo 1" (si al ejecutar el código de nuevo) seria "reportes respaldo 2" algo así...
luego de crear respaldo...
2- Que limpie rangos de distintas hojas de mi libro original
Osea que el libro "original" al ejecutar el código debe crear un respaldo tal cual esta.. Guardarlo en el escritorio con un nombre que lo distinga y limpiarlo para seguir dando uso.
1 Respuesta
Te anexo la macro para el punto 1.
En los eventos de thisworkbook pon lo siguiente:
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Por.Dante Amor Respaldo End Sub
Ahora, en un módulo pon las siguientes macros:
Sub Respaldo()
'Por.Dante Amor
nombre = ThisWorkbook.Name
der = InStrRev(nombre, ".")
nombre = Left(nombre, der - 1)
Resp = MsgBox("Desea Guardar una Copia?", vbQuestion + vbYesNo, "Atención")
If Resp = vbYes Then
'Application.Dialogs(xlDialogSaveAs).Show
ruta = escritorio
fecha = Format(Date, "ddmmyyyy")
con = 1
If ruta <> "" Then
ruta = ruta & "\"
Do While True
completo = ruta & nombre & fecha & "-" & con & ".xlsm"
If Dir(completo) = "" Then
Exit Do
Else
con = con + 1
End If
Loop
ActiveWorkbook.SaveCopyAs completo
End If
End If
End Sub
'
Function escritorio() As String
'Por.DAM
'Referencia: http://www.ozgrid.com/forum/showthread.php?t=24985
Dim objWSHShell As Object
Dim strSpecialFolderPath
On Error GoTo ErrorHandler
Set objWSHShell = CreateObject("WScript.Shell")
escritorio = objWSHShell.SpecialFolders("Desktop")
Set objWSHShell = Nothing
Exit Function
ErrorHandler:
'MsgBox "Error NO se encuentra el folder ", vbCritical + vbOKOnly, "Error"
escritorio = ""
End FunctionCuando cierres el libro , te creará un respaldo con lo siguiente
c:\escritorio\"nombre del archivo" 13032015 - 1.xlsm
Si vuelves a guardar otro archivo el mismo día:
c:\escritorio\"nombre del archivo" 13032015 - 2.xlsm
Al siguiente día te guardará el archivo así:
c:\escritorio\"nombre del archivo" 14032015 - 1.xlsm
Podrías poner el punto 2 en una nueva pregunta.
me sale error en:
nombre = Left(nombre, der - 1)
me sale la ventana de donde desea guardar, el libro original no debe cerrarse solo generar el respaldo con el nombre del libro y la fecha..
espero tu ayuda...
Cambia la macro por esta:
Sub Respaldo()
'Por.Dante Amor
nombre = ThisWorkbook.Name
der = InStrRev(nombre, ".")
If der > 0 Then
nombre = Left(nombre, der - 1)
End If
Resp = MsgBox("Desea Guardar una Copia?", vbQuestion + vbYesNo, "Atención")
If Resp = vbYes Then
'Application.Dialogs(xlDialogSaveAs).Show
ruta = escritorio
fecha = Format(Date, "ddmmyyyy")
con = 1
If ruta <> "" Then
ruta = ruta & "\"
Do While True
completo = ruta & nombre & fecha & "-" & con & ".xlsm"
If Dir(completo) = "" Then
Exit Do
Else
con = con + 1
End If
Loop
ActiveWorkbook.SaveCopyAs completo
End If
End If
End Sub
'
Function escritorio() As String
'Por.DAM
'Referencia: http://www.ozgrid.com/forum/showthread.php?t=24985
Dim objWSHShell As Object
Dim strSpecialFolderPath
On Error GoTo ErrorHandler
Set objWSHShell = CreateObject("WScript.Shell")
escritorio = objWSHShell.SpecialFolders("Desktop")
Set objWSHShell = Nothing
Exit Function
ErrorHandler:
'MsgBox "Error NO se encuentra el folder ", vbCritical + vbOKOnly, "Error"
escritorio = ""
End FunctionCopia bien la macro.
La macro que te estoy enviando no tiene ninguna ventana para escoger dónde deseas guarda, revisa que no tengas otras macros.
Solamente aparece un mensaje con la pregunta: "Desea guardar una copia".
Todo empieza cuando vas a cerrar el libro.
Y por último, la macro no cierra el libro original.
Tu petición es esta: "Lo que requiero es que antes de cerrar mi libro original"
La macro lleva varias cosas.
1. Cuando presionas el botón cerrar de tu libro original, se activa la macro "Respaldo"
2. Busca tu carpeta de escritorio.
3. Obtiene el nombre de tu libro original
4. Le agrega la fecha al nombre
5. Agrega un consecutivo al nombre
6. Guarda un respaldo
7. Cuando termina de hacer eso el libro original se cierra, porque eso es lo que tu le indicaste a excel cuanto presionaste el botón cerrar.
Si no quieres que sea cuando presionas cerrar de excel, entonces simplemente pon un botón y asigna la macro respaldo.
