Copia Backup

   Hola a todos, antes de nada, FELIZ AÑO, y esperemos que este sea mejor que el anterior.Y aquí va mi primera pregunta del año.
Veréis, tengo este código con el que pretendo, primero elegir carpeta (que lo hace), segundo elegir archivo (que lo hace), y luego con el botón iniciar, lo que quiero es que me genere la copia de seguridad y me lo guarde donde yo le digo, pero lo que hace es guardármelo así:

Backups02.01.21-Clínica - V.1.0.accdb

pero en el directorio raíz.

Espero como siempre vuestras enseñanzas y ayudas

Private Sub btniniciar_Click()
On Error GoTo sol_err

'Declaramos las variables
Dim fsa As Scripting.File
Dim fsc As Scripting.Folder
Dim fso As Scripting.FileSystemObject
Dim vRutaFullBD As String
Dim vNomBD As String
Dim vNomBackup As String
Dim vRutaBackup As String
Dim vFullBackup As String
Dim vRutaArchivo As String
Dim vRutaCarpeta As String
Dim vExisteArchivo As Boolean
Dim vResp As Integer

vRutaArchivo = Me.txtarchivo
vRutaCarpeta = Me.txtcarpeta
vRutaFullBD = Application.CurrentProject.FullName
vNomBD = Application.CurrentProject.Name
vRutaBackup = Application.CurrentProject.Path
vNomBackup = Format(Date, "dd.mm.yy") & "-" & vNomBD

vFullBackup = vRutaCarpeta & vNomBackup

vResp = MsgBox("Se va a crear copia de seguridad de la Base de Datos" _
        & vbCrLf & vNomBackup _
        & vbCrLf & vbTab & "¿Continuar?", vbQuestion + vbYesNo, "Clínica - V.1.0")
If vResp = vbNo Then Exit Sub

Set fso = New Scripting.FileSystemObject
Set fsc = fso.GetFolder(vRutaBackup)
vExisteArchivo = True

Set fsa = fso.GetFile(vFullBackup)

If vExisteArchivo = True Then
vResp = MsgBox("Ya existe un backup con el mismo nombre. ¿Desea sobrescribirlo?", _
vbQuestion + vbYesNo, "Clínica - V.1.0")
'Si el usuario no desea sobreescribir salimos del proceso
If vResp = vbNo Then Exit Sub
End If
'Finalmente, guardamos la copia de seguridad
fso.CopyFile vRutaArchivo, vFullBackup
'Lanzamos un mensaje de aviso
MsgBox "Copia de seguridad realizada correctamente", vbInformation, "Clínica - V.1.0"
Salida:
    Exit Sub
sol_err:
        'Gestionamos los errores 76, 53 y otros.
    Select Case Err.Number
        Case 76 'La carpeta no existe
                    'Creamos la carpeta
            fso.CreateFolder (vRutaBackup)
                'Seguimos con la ejecución del código en el punto de interrupción
            Resume Next
        Case 53 'El archivo no existe
                    'Cambiamos el valor de vExisteArchivo
            vExisteArchivo = False
                'Seguimos con la ejecución del código en el punto de interrupción
            Resume Next
        Case Else 'Si se produce otro error
            MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description
            Resume Salida
    End Select

End Sub

Editado por Marcos141964 - 02/Enero/2021 a las 20:06

Autor	Mensaje Tema Buscar Opciones del Tema Responder Crear un nuevo tema Versión imprimible Traducir Tema
Marcos141964 Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Asiduo Unido: 01/Octubre/2020 Localización: Adeje-Tenerife Estado: Sin conexión Puntos: 201	Opciones de entrada Responder Cita Marcos141964 Informar de mensaje Gracias(0) Cita Respuesta Tema: Copia Backup Enviado: 02/Enero/2021 a las 20:05
	Hola a todos, antes de nada, FELIZ AÑO, y esperemos que este sea mejor que el anterior. Y aquí va mi primera pregunta del año. Veréis, tengo este código con el que pretendo, primero elegir carpeta (que lo hace), segundo elegir archivo (que lo hace), y luego con el botón iniciar, lo que quiero es que me genere la copia de seguridad y me lo guarde donde yo le digo, pero lo que hace es guardármelo así: Backups02.01.21-Clínica - V.1.0.accdb pero en el directorio raíz. Espero como siempre vuestras enseñanzas y ayudas Private Sub btniniciar_Click() On Error GoTo sol_err 'Declaramos las variables Dim fsa As Scripting.File Dim fsc As Scripting.Folder Dim fso As Scripting.FileSystemObject Dim vRutaFullBD As String Dim vNomBD As String Dim vNomBackup As String Dim vRutaBackup As String Dim vFullBackup As String Dim vRutaArchivo As String Dim vRutaCarpeta As String Dim vExisteArchivo As Boolean Dim vResp As Integer vRutaArchivo = Me.txtarchivo vRutaCarpeta = Me.txtcarpeta vRutaFullBD = Application.CurrentProject.FullName vNomBD = Application.CurrentProject.Name vRutaBackup = Application.CurrentProject.Path vNomBackup = Format(Date, "dd.mm.yy") & "-" & vNomBD vFullBackup = vRutaCarpeta & vNomBackup vResp = MsgBox("Se va a crear copia de seguridad de la Base de Datos" _ & vbCrLf & vNomBackup _ & vbCrLf & vbTab & "¿Continuar?", vbQuestion + vbYesNo, "Clínica - V.1.0") If vResp = vbNo Then Exit Sub Set fso = New Scripting.FileSystemObject Set fsc = fso.GetFolder(vRutaBackup) vExisteArchivo = True Set fsa = fso.GetFile(vFullBackup) If vExisteArchivo = True Then vResp = MsgBox("Ya existe un backup con el mismo nombre. ¿Desea sobrescribirlo?", _ vbQuestion + vbYesNo, "Clínica - V.1.0") 'Si el usuario no desea sobreescribir salimos del proceso If vResp = vbNo Then Exit Sub End If 'Finalmente, guardamos la copia de seguridad fso.CopyFile vRutaArchivo, vFullBackup 'Lanzamos un mensaje de aviso MsgBox "Copia de seguridad realizada correctamente", vbInformation, "Clínica - V.1.0" Salida: Exit Sub sol_err: 'Gestionamos los errores 76, 53 y otros. Select Case Err.Number Case 76 'La carpeta no existe 'Creamos la carpeta fso.CreateFolder (vRutaBackup) 'Seguimos con la ejecución del código en el punto de interrupción Resume Next Case 53 'El archivo no existe 'Cambiamos el valor de vExisteArchivo vExisteArchivo = False 'Seguimos con la ejecución del código en el punto de interrupción Resume Next Case Else 'Si se produce otro error MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description Resume Salida End Select End Sub Editado por Marcos141964 - 02/Enero/2021 a las 20:06
	Marcos José López de Dios

rokoko Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 2790	Opciones de entrada Responder Cita rokoko Informar de mensaje Gracias(0) Cita Respuesta Enviado: 02/Enero/2021 a las 21:43
	Aqui que tienes exactamente vRutaCarpeta = Me.txtcarpeta El directorio que crees debe ser completo, es decir algo asi por ejemplo, atento a los espacios tambien.... Z:\Copias\2021\Backups\02.01.21-Clínica - V.1.0.accdb

Marcos141964 Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Asiduo Unido: 01/Octubre/2020 Localización: Adeje-Tenerife Estado: Sin conexión Puntos: 201	Opciones de entrada Responder Cita Marcos141964 Informar de mensaje Gracias(0) Cita Respuesta Enviado: 02/Enero/2021 a las 22:08
	C:\Users\marco\Desktop\Clínica - V.1.0\Backups\ es la ruta que me pone en un cuadro de texto a través de un botón
	Marcos José López de Dios

rokoko Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Colaborador Unido: 16/Febrero/2008 Localización: Pamplona Estado: Sin conexión Puntos: 2790	Opciones de entrada Responder Cita rokoko Informar de mensaje Gracias(0) Cita Respuesta Enviado: 02/Enero/2021 a las 23:06
	Pues creo que te falta en el codigo una barra \ despues de backups..... Yo la pondria en txtcarpeta.....

Marcos141964 Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Asiduo Unido: 01/Octubre/2020 Localización: Adeje-Tenerife Estado: Sin conexión Puntos: 201	Opciones de entrada Responder Cita Marcos141964 Informar de mensaje Gracias(0) Cita Respuesta Enviado: 02/Enero/2021 a las 23:36
	Gracias rokoko, solucionado me funciona, feliz año. Se puede cerrar el tema
	Marcos José López de Dios