Ayuda, desesperado, Backup, ¿Error en CopyFolder?

[hoygan]

Necesito hacer una aplicacion que me haga copias de seguridad de un/os directorio/s los cuales cogen su ruta de cada linea de un fichero .txt y que me cree dentro de esa ruta un directorio para cada dia de la semana. También va con un temporizador para que se ejecute cada dia. Agregué la referencia MS Script Runtime y me lo hace todo bien salvo la ruta de destino(variable "destino") que pongo SOLO en CopyFolder(en el resto me va bien). Mi codigo es el siguiente:

Dim origen as string
Dim destino as string
Dim fecha as date
Dim dianum as integer
Dim dia as string
Dim FSO as FileSystemObject
Dim creado as Boolean
Dim M as integer
Option Explicit

Private Sub Form_Load()
Timer1.Enabled=True
Timer1.Interval=3000 (Este no es el intervalo real, es solo para pruebas)
End Sub

Private Sub Timer1_Timer()
'Obtengo dia de la semana:
fecha=Date
dianum=Weekday(fecha)
dia=WeekDayName(dianum, ,vbSunday)

'Obtengo rutas del fichero:
M=FreeFile
Open "ruta.txt" For Input as M
Do While Not EOF(M)
Line Input #M, origen

'Crear directorios y copiar:
destino= origen & "\" & dia
Set FSO=NewFileSystemObject
creado=FSO.FolderSystemObject
If creado=True Then
FSO.DeleteFolder(destino)
FSO.CreateFolder(destino)
FSO.CopyFolder origen, destino, True

Else
FSO.CreateFolder(destino)
FSO.CopyFolder origen, destino, True
End If
Set FSO=Nothing
Loop

End Sub

---------------------------
He probado a liberar el objeto antes de copiarlo, a hacer un GetFolder y meterlo en una variable para luego ponerla como destino, etc.

En fin, he probado bastantes cosas y no va(y es lo raro, ya que es bien simple y es una libreria muy usada, así que algo se me escapa y no se el que), ya que el error es: "Error '5' , Llamada a procedimiento o argumentos no válidos"

Ruego la sabídura y la bondad de cualquier deidad de la programacion que ayude urgentemente a este noobie al cual le pende la espada de Damócles sobre su cabeza, sostenida por su jefe :D.

Gracias de antemano.

[Foxi]

Buenas hoygan:

No hay nada como tener un par de funciones guardadas por ahí para ayudar de vez en cuando... A ver si te valen:

Código:

'********************************************************************************
'Nombre: F_nCopia_Directorio
'Descripción: Copia un directorio, incluyendo los ficheros y subdirectorios.
'               Si no existe el fichero origen se devuelve -2.
'               Si se produce algún error devuelve -3.
'Fecha: 17/06/2005
'********************************************************************************
Function F_nCopia_Directorio(ByVal v_sDirectorioOrigen As String, _
        ByVal v_sDirectorioDestino As String, _
        Optional ByVal v_bReemplazar As Boolean = True) As Integer
Dim fso As New FileSystemObject
Dim fldrCarpeta As Folder
Dim fldrSubCarpetas
Dim fldrCarpetaTemp
Dim Ficheros
Dim FicherosTemp
    
    F_nCopia_Directorio = 0
    
    On Error GoTo Error_Copia_Dir
    
    ' Si el texto de los directorios no teminan con "\", lo añado:
    If (Right(v_sDirectorioOrigen, 1) <> "\") Then
        v_sDirectorioOrigen = v_sDirectorioOrigen + "\"
    End If
    If (Right(v_sDirectorioDestino, 1) <> "\") Then
        v_sDirectorioDestino = v_sDirectorioDestino + "\"
    End If
    
    ' Se comprueba que exista el directorio origen.
    If (Dir(v_sDirectorioOrigen) = "") Then
        F_nCopia_Directorio = -2
    Else
        
        ' Si no existe el directorio de destino se crea.
        Call F_bComprueba_Crea_Directorio(v_sDirectorioDestino)
        
        Set fldrCarpeta = fso.GetFolder(v_sDirectorioOrigen)
        
        ' Se copian cada uno de los subdirectorios del directorio origen.
        Set fldrSubCarpetas = fldrCarpeta.SubFolders
        For Each fldrCarpetaTemp In fldrSubCarpetas
            Call fldrCarpetaTemp.Copy(v_sDirectorioDestino, v_bReemplazar)
        Next
        
        ' Se copian cada uno de los ficheros del directorio origen.
        Set Ficheros = fldrCarpeta.Files
        For Each FicherosTemp In Ficheros
            Call FicherosTemp.Copy(v_sDirectorioDestino, v_bReemplazar)
        Next
        
        ' Elimino las referencias.
        Set fldrSubCarpetas = Nothing
        Set Ficheros = Nothing
        Set fldrCarpeta = Nothing
        
    End If
    
    Exit Function
    
Error_Copia_Dir:
    F_nCopia_Directorio = -3
End Function

Fíjate bien que se utiliza una función en la que se comprueba la existencia de un directorio, y si no existe, se crea dicho directorio... Te adjunto también esta función:

Código:

'********************************************************************************
'Nombre: F_bComprueba_Crea_Directorio
'Descripción: Comprueba si existe un directorio pasado como parámetro, si no existe
'              lo crea creando, si hace falta, los directorios padres.
'             Si no se puede crear el directorio se devuelve False.
'Fecha: 02/11/2004
'********************************************************************************
Function F_bComprueba_Crea_Directorio(v_sDirectorio As String) As Boolean
Dim sDirectorio_Temp As String
Dim bSin_Directorios_Padres As Boolean
Dim nPosicion_Temp As Integer
Dim bComprobado_Dir_Padre As Boolean
    
    ' Inicializo valores.
    sDirectorio_Temp = v_sDirectorio
    bSin_Directorios_Padres = False
    bComprobado_Dir_Padre = False
    nPosicion_Temp = 0
    
    ' Efectúo un bucle hasta que se cree el directorio final o no se encuentren
    '  directorios padres.
    While ((Dir(sDirectorio_Temp, vbDirectory) = "") And _
            (bSin_Directorios_Padres = False))
        
        ' Compruebo que el directorio tenga directorio padre.
        nPosicion_Temp = F_Buscar_Texto(sDirectorio_Temp, "\", nPosicion_Temp)
        If (nPosicion_Temp = -1) Then
            If (bComprobado_Dir_Padre = False) Then
                bSin_Directorios_Padres = True
            Else
                nPosicion_Temp = Len(sDirectorio_Temp) + 1
                sDirectorio_Temp = sDirectorio_Temp & "\"
            End If
        End If
        
        If (nPosicion_Temp > -1) Then
            If (Dir(Left(sDirectorio_Temp, nPosicion_Temp - 1), vbDirectory) = "") Then
                Call MkDir(Left(sDirectorio_Temp, nPosicion_Temp - 1))
            Else
                bComprobado_Dir_Padre = True
            End If
        Else
            bSin_Directorios_Padres = True
        End If
        
        ' Inicializo el directorio original.
        sDirectorio_Temp = v_sDirectorio
        
    Wend
    
    F_bComprueba_Crea_Directorio = Not bSin_Directorios_Padres
    
End Function

Saludos Foxi.

[Avellaneda]

Bueno, ahí va un código algo mas sencillo

Código:

Dim Folder As Folder
Set Folder = FSO.GetFolder(origen)
Folder.Copy destino

Si "destino" no existe, lo crea y si existe lo machaca.

Un saludo

[Foxi]

La verdad es que es mucho más sencillo, pero si no recuerdo mal: cuando lo hice (hace ya algunos añitos), daba algún tipo de problemas si el directorio de destino no tenía creado el directorio padre, o si el directorio a copiar tenía a su vez subdirectorios (los cuales a su vez podían tener subdirectorios).

Supongo que hoy en día podría hacerlo más corto, pero ¿para qué? Si tengo un código que funciona...

Saludos, Foxi.

[hoygan]

He probado el codigo de Avellaneda y no ha funcionado.
Y el de Foxi me da un error de compilacion en la siguiente linea de la funcion "F_bComprueba_Crea_Directorio":

nPosicion_Temp = F_Buscar_Texto(sDirectorio_Temp, "\", nPosicion_Temp)

Concretamente me resalta F_Buscar_Texto diciendo que no está definido.

[Foxi]

Perdón, esa función es una que me hice cuando no me conocía la función InStr. Sustituyela por InStr, y pruébalo....

Saludos, Foxi.

[hoygan]

Ya, ya, saqué un poco por logica que seria eso. De todas maneras tu codigo solo me copia las carpetas que no tienen el nombre de ese dia y lo que cuelga de ellas, en cambio los archivos sueltos no los copia y lo que hace es machacar la carpeta. Pero he podido solucionarlo añadiendol otra funcion que encontré:

Código:

Private Function CopiaFichDir(origen As String, destino As String, NumFiles As Integer)
Dim FileName As String
Dim filedir As String
Dim oldDir As String
Dim newDir As String

oldDir = origen
If Right$(oldDir, 1) <> "\" Then
oldDir = oldDir & "\"
End If

newDir = destino
If Right$(newDir, 1) <> "\" Then
newDir = newDir & "\"
End If

NumFiles = 0

FileName = Dir(oldDir & "*.*")

While FileName <> ""

FileCopy oldDir & FileName, newDir & FileName

NumFiles = NumFiles + 1

FileName = Dir$

DoEvents
Wend

End Function

Muchisimas gracias que algun ente divino os acoja en vuestra gloria,xD.

[hoygan]

Y una duda sobre el Timer en esta aplicacion:
¿Si le indico un intervalo de 24 horas(expresado en milisegundos) me lo admitirá? ¿O será demasiado?

[Foxi]

No sé por qué no te ha funcionado lo de la copia de los archivos, pero si te vale con lo que has encontrado no voy a entrar más en detalle..

Para lo del intervalo del Timer: No admite un valor superior a 65.535 milisegundos (algo más de un segundo), para ejecutarlo como si fuera con un intervalo más grande te sugiero un par de ideas:
1 .- Podrías ejecutarlo cada 60.000 (un minuto) y tener un contador en una variable de módulo que se vaya incrementando cada vez que se entre en el Timer... Y ejecutar la función que le quieres dar al Timer cuando el contador llegue a x veces (60 minutos * 24 horas = 1440).
- En este caso no controlas exactamente cuándo se ejecuta la función que quieres, aunque el código se hace muy simple. Peligro si se te olvida reiniciar el contador. -
2 .- O puedes ejecutar el Timer cada x tiempo (siempre menor de 65,535 segundos), y comprobar la hora del sistema con respecto a una hora determinada en la que debiera de ejecutarse la función inicial.
- Con esta opción podrás ejecutar la función no sólo cada 24 horas, sino a una hora determinada que siempre será más controlable. El código para comprobar las fechas te puede costar una poco más. -

Saludos,
Foxi.

[seba123neo]

Hola,el timer como dijeron solo acepta un poco mas de un minuto por intervalo,pero con un pequeño codigo podes hacer que acepte el intervalo que quieras 10 minutos, 1 hora,lo que quieras..

saludos.

[hoygan]

Iniciado por Foxi

No sé por qué no te ha funcionado lo de la copia de los archivos, pero si te vale con lo que has encontrado no voy a entrar más en detalle..

Ahora que he probado más en detalle resulta que no me copia nada si no encuenta archivos sueltos en el directorio "origen". En cambio, basta con que haya cualquier archivo suelto para que me copie directorios recursivamente y los archivos sueltos en el directorio destino :S.

¡Mi aplicación está endemoniada!

EDIT: Ya lo solucioné, me fallaba por esto:

Código:

Function F_Copia_Dir(origen As String, destino As String, _
Optional v_bReemplazar As Boolean = True) As Integer
Dim fso As New FileSystemObject
Dim fldrCarpeta As Folder
Dim fldrSubCarpetas
Dim fldrCarpetaTemp
Dim Ficheros
Dim FicherosTemp
Dim P As Integer

F_Copia_Dir = 0

On Error GoTo Error_Copia_Dir

If (Right(origen, 1) <> "\") Then
origen = origen + "\"
End If
If (Right(destino, 1) <> "\") Then
destino = destino + "\"
End If

If (Dir(origen) = "") Then
F_Copia_Dir = -2
Else

' Si no existe el directorio de destino se crea.
        Call F_bComprueba_Crea_Directorio(destino)
        
        Set fldrCarpeta = fso.GetFolder(origen)
        
        ' Se copian cada uno de los subdirectorios del directorio origen.
        Set fldrSubCarpetas = fldrCarpeta.SubFolders
        For Each fldrCarpetaTemp In fldrSubCarpetas
            Call fldrCarpetaTemp.Copy(destino, v_bReemplazar)
        Next
' Se copian cada uno de los ficheros del directorio origen.
            Set Ficheros = fldrCarpeta.Files
            For Each FicherosTemp In Ficheros
                Call FicherosTemp.Copy(destino, v_bReemplazar)
            Next

' Elimino las referencias.
        Set fldrSubCarpetas = Nothing
        Set Ficheros = Nothing
        Set fldrCarpeta = Nothing
        
    End If
    

    Exit Function
    
Error_Copia_Dir:
    F_Copia_Dir = -3
     Call CopiaFichDir(origen, destino, P)
End Function

Quité esa condicion y ya me lo hace.

[Foxi]

Para que conste:

He tenido que utilizar la función "F_bComprueba_Crea_Directorio" para comprobar si existe un directorio (y si no existe crearlo), y me he acordado de que lo había compartido con el Foro en esta consulta, utilizando una función propia "F_Buscar_Texto" en vez de InStr... Me he dado cuenta de que los resultados de estas dos funciones difieren en caso de que no se encuentre el texto buscado... La función "F_bComprueba_Crea_Directorio" utilizando InStr cambia un poquito por ello, la muetsro para el que lo quiera utilizar correctamente:

Código:

'********************************************************************************
'Nombre: F_bComprueba_Crea_Directorio
'Descripción: Comprueba si existe un directorio pasado como parámetro, si no existe
'              lo crea creando, si hace falta, los directorios padres.
'             Si no se puede crear el directorio se devuelve False.
'Fecha: 02/11/2004
'********************************************************************************
Function F_bComprueba_Crea_Directorio(v_sDirectorio As String) As Boolean
Dim l_sDirectorio_Temp As String
Dim l_bSin_Directorios_Padres As Boolean
Dim l_nPosicion_Temp As Integer
Dim l_bComprobado_Dir_Padre As Boolean
    
    ' Inicializo valores.
    l_sDirectorio_Temp = v_sDirectorio
    l_bSin_Directorios_Padres = False
    l_bComprobado_Dir_Padre = False
    l_nPosicion_Temp = 0
    
    ' Efectúo un bucle hasta que se cree el directorio final o no se encuentren
    '  directorios padres.
    While ((Dir(l_sDirectorio_Temp, vbDirectory) = "") And _
            (l_bSin_Directorios_Padres = False))
        
        ' Compruebo que el directorio tenga directorio padre.
        l_nPosicion_Temp = l_nPosicion_Temp + 1
        l_nPosicion_Temp = InStr(l_nPosicion_Temp, l_sDirectorio_Temp, "\", vbTextCompare)
        If (l_nPosicion_Temp < 1) Then
            If (l_bComprobado_Dir_Padre = False) Then
                l_bSin_Directorios_Padres = True
            Else
                l_nPosicion_Temp = Len(l_sDirectorio_Temp) + 1
                l_sDirectorio_Temp = l_sDirectorio_Temp & "\"
            End If
        End If
        
        If (l_nPosicion_Temp > 0) Then
            If (Dir(Left(l_sDirectorio_Temp, l_nPosicion_Temp - 1), vbDirectory) = "") Then
                Call MkDir(Left(l_sDirectorio_Temp, l_nPosicion_Temp - 1))
            Else
                l_bComprobado_Dir_Padre = True
            End If
        Else
            l_bSin_Directorios_Padres = True
        End If
        
        ' Inicializo el directorio original.
        l_sDirectorio_Temp = v_sDirectorio
        
    Wend
    
    F_bComprueba_Crea_Directorio = Not l_bSin_Directorios_Padres
    
End Function

Saludos, Foxi.