Copiar Carpetas

[ENAT_123]

Alguien me puede ayudar? tengo que copiar todos los archivos de una carpeta en otra y no se como hacerlo. Con la orden filecopy solo copia un archivo pero yo necesito copiar toda la carpeta . AYUDA POR FAVOR

[aldo1982]

aca algo de ayuda.

crea este .bas y pones este codigo

Código:

Enum CompareDirectoryEnum
cdeSourceDirOnly = -2       
cdeDestDirOnly = -1     
cdeEqual = 0            
cdeSourceIsNewer = 1
cdeSourceIsOlder = 2    older
cdeDateDiffer = 3   
cdeSizeDiffer = 4       
cdeAttributesDiffer = 8 End Enum


Sub SynchronizeDirectoryTrees(ByVal sourceDir As String, _
    ByVal destDir As String, Optional ByVal TwoWaySync As Boolean)
    Dim fso As New Scripting.FileSystemObject
    Dim sourceFld As Scripting.Folder
    Dim destFld As Scripting.Folder
    Dim fld As Scripting.Folder
    Dim col As New Collection
    
    On Error Resume Next
    
   
    Set sourceFld = fso.GetFolder(sourceDir)
    Set destFld = fso.GetFolder(destDir)

        If Err Then
                fso.CopyFolder sourceDir, destDir
        
        Exit Sub
    End If
    
     SynchronizeDirectories sourceDir, destDir, TwoWaySync
    
    
    If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
    If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
    
        For Each fld In sourceFld.SubFolders
               col.Add fld.Name, fld.Name
        
               SynchronizeDirectoryTrees fld.Path, destDir & fld.Name, TwoWaySync
        DoEvents
    Next
    
    
    If TwoWaySync Then
        For Each fld In destFld.SubFolders
            If col(fld.Name) = "" Then
                    fso.CopyFolder fld.Path, sourceDir & fld.Name
            End If
        Next
    End If

End Sub




Function CompareDirectories(ByVal sourceDir As String, ByVal destDir As String) _
    As Variant()
    Dim fso As New Scripting.FileSystemObject
    Dim sourceFld As Scripting.Folder
    Dim destFld As Scripting.Folder
    Dim sourceFile As Scripting.File
    Dim destFile As Scripting.File
    Dim col As New Collection
    Dim index As Long
    Dim FileName As String
    
        Set sourceFld = fso.GetFolder(sourceDir)
    Set destFld = fso.GetFolder(destDir)
    
        If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
    
        ReDim res(1, sourceFld.files.Count + destFld.files.Count) As Variant
    
        On Error Resume Next
    

    For Each sourceFile In sourceFld.files
        ' this is the name of the file
        FileName = sourceFile.Name
        
        ' add file name to array
        index = index + 1
        res(0, index) = FileName
        
        ' add file name to collection (to be used later)
        col.Add FileName, FileName
        
        ' try to get a reference to destination file
        Set destFile = fso.GetFile(destDir & FileName)
        
        If Err Then
            Err.Clear
            ' file exists only in source directory
            res(1, index) = cdeSourceDirOnly
            
        Else
            ' if the file exists in both directories,
            '  start assuming it's the same file
            res(1, index) = cdeEqual
            
            ' compare file dates
            Select Case DateDiff("s", sourceFile.DateLastModified, _
                destFile.DateLastModified)
                Case Is < 0
                    ' source file is newer
                    res(1, index) = cdeSourceIsNewer
                Case Is > 0
                    ' source file is newer
                    res(1, index) = cdeSourceIsOlder
            End Select
            
            ' compare attributes
            If sourceFile.Attributes <> destFile.Attributes Then
                res(1, index) = res(1, index) Or cdeAttributesDiffer
            End If
            
            ' compare size
            If sourceFile.Size <> destFile.Size Then
                res(1, index) = res(1, index) Or cdeSizeDiffer
            End If
        End If
    Next
    
    ' now we only need to add all the files in destination directory
    ' that don't appear in the source directory
    For Each destFile In destFld.files
        ' it's faster to search in the collection
        If col(destFile.Name) = "" Then
            ' we get here only if the filename isn't in the collection
            ' add the file to the result array
            index = index + 1
            res(0, index) = destFile.Name
            ' remember this only appears in the destination directory
            res(1, index) = cdeDestDirOnly
        End If
    Next
    
    ' trim and return the result
    If index > 0 Then
        ReDim Preserve res(1, index) As Variant
        CompareDirectories = res
    End If

End Function



' Synchronize two directories
'
' This routine compares source and dest directories and copies files
' from source that are newer than (or are missing in) the destination directory

' if TWOWAYSYNC is True, files are synchronized in both ways

' NOTE: requires the CompareDirectories routine and a reference to
'       the Microsoft Scripting Runtime type library

Sub SynchronizeDirectories(ByVal sourceDir As String, ByVal destDir As String, _
    Optional ByVal TwoWaySync As Boolean)
    Dim fso As New Scripting.FileSystemObject
    Dim index As Long
    Dim copyDirection As Integer    ' 1=from source dir, 2=from dest dir,
                                    '  0=don't copy
    
    ' retrieve name of files in both directories
    Dim arr() As Variant
    arr = CompareDirectories(sourceDir, destDir)
    
    ' ensure that both dir names have a trailing backslash
    If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
    If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
    
    For index = 1 To UBound(arr, 2)
        ' assume this file doesn't need to be copied
        copyDirection = 0
        
        ' see whether files are
        Select Case arr(1, index)
            Case cdeEqual
                ' this file is the same in both directories
            Case cdeSourceDirOnly
                ' this file exists only in source directory
                copyDirection = 1
            Case cdeDestDirOnly
                ' this file exists only in destination directory
                copyDirection = 2
            Case Else
                If arr(1, index) = cdeAttributesDiffer Then
                    ' ignore files that differ only for their attributes
                ElseIf (arr(1, index) And cdeDateDiffer) = cdeSourceIsOlder Then
                    ' file in destination directory is newer
                    copyDirection = 2
                Else
                    ' in all other cases file in source dir should be copied
                    ' into dest dire
                    copyDirection = 1
                End If
        End Select
        
        If copyDirection = 1 Then
            ' copy from source dir to destination dir
            fso.CopyFile sourceDir & arr(0, index), destDir & arr(0, index), _
                True
        ElseIf copyDirection = 2 And TwoWaySync Then
            ' copy from destination dir to source dir
            ' (only if two-way synchronization has been requested)
            fso.CopyFile destDir & arr(0, index), sourceDir & arr(0, index), _
                True
        End If
        DoEvents
    Next
End Sub

luego pones dos cajas de texto (txtSource y txtDestination) y un boton. aca abajo los nombres de cada o

y dentro del boton pones este codigo:

Código:

Call SynchronizeDirectoryTrees(txtSource, txtDestination, False)

salu2 y espero te sirva

[ENAT_123]

gracias lo voy a probar ahora mismo ya te contare. muchas gracias

[aldo1982]

Iniciado por ENAT_123

gracias lo voy a probar ahora mismo ya te contare. muchas gracias

dnd sino me avisas y te madno un ejemplo si ando con tiempo.
salu2

[ENAT_123]

esto me va perfecto, muchas gracias