es posible hacer en vb?

[lokoman]

Algo se está quedando.... crea un proyecto nuevo, pon los dos textbox (txtSource y txtDestination) y un Command con el nombre cmdCopiar. Llenas los texbox con la ruta fuente y el destino. Este es el codigo completo:

Enum CompareDirectoryEnum
cdeSourceDirOnly = -2
cdeDestDirOnly = -1
cdeEqual = 0
cdeSourceIsNewer = 1
cdeSourceIsOlder = 2
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
FileName = sourceFile.Name
index = index + 1
res(0, index) = FileName
col.Add FileName, FileName
Set destFile = fso.GetFile(destDir & FileName)
If Err Then
Err.Clear
res(1, index) = cdeSourceDirOnly
Else
res(1, index) = cdeEqual
Select Case DateDiff("s", sourceFile.DateLastModified, _
destFile.DateLastModified)
Case Is < 0
res(1, index) = cdeSourceIsNewer
Case Is > 0
res(1, index) = cdeSourceIsOlder
End Select
If sourceFile.Attributes <> destFile.Attributes Then
res(1, index) = res(1, index) Or cdeAttributesDiffer
End If
If sourceFile.Size <> destFile.Size Then
res(1, index) = res(1, index) Or cdeSizeDiffer
End If
End If
Next

For Each destFile In destFld.Files
If col(destFile.Name) = "" Then
index = index + 1
res(0, index) = destFile.Name
res(1, index) = cdeDestDirOnly
End If
Next
If index > 0 Then
ReDim Preserve res(1, index) As Variant
CompareDirectories = res
End If

End Function

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

Dim arr() As Variant
arr = CompareDirectories(sourceDir, destDir)

If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"

For index = 1 To UBound(arr, 2)
copyDirection = 0

Select Case arr(1, index)
Case cdeEqual
Case cdeSourceDirOnly
copyDirection = 1
Case cdeDestDirOnly
copyDirection = 2
Case Else
If arr(1, index) = cdeAttributesDiffer Then
ElseIf (arr(1, index) And cdeDateDiffer) = cdeSourceIsOlder Then
copyDirection = 2
Else
copyDirection = 1
End If
End Select

If copyDirection = 1 Then
fso.CopyFile sourceDir & arr(0, index), destDir & arr(0, index), _
True
ElseIf copyDirection = 2 And TwoWaySync Then
fso.CopyFile destDir & arr(0, index), sourceDir & arr(0, index), _
True
End If
DoEvents
Next
End Sub

Private Sub cmdCopiar_Click()
If MsgBox("Este proceso tardará varios minutos en completarse!!" & vbNewLine _
& "Desea empezar la copia?", vbQuestion & vbYesNo) = vbYes Then
Dim I As Integer
DoEvents
Call SynchronizeDirectoryTrees(txtSource, txtDestination, False)
DoEvents
MsgBox "Proceso completado!!", vbInformation
End If
End Sub