es posible hacer en vb?

[lokoman]

Pon una referencia a MICROSOFT SCRIPTIN RUNTIME, esta en c:\windows\system32\scrrun.dll

Faltó una parte:


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 ' 1=from source dir, 2=from dest dir,
' 0=don't copy

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