Ayuda, desesperado, Backup, ¿Error en CopyFolder?

[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.