?
Solved

Comparing contents two folders

Posted on 2003-03-30
7
Medium Priority
?
285 Views
Last Modified: 2010-04-07
Does anyone know how I can compare the contents of two folders (including sub folders), then copy what's different in Folder1 to Folder2.  Then delete what exists in Folder2, but not Folder1.
0
Comment
Question by:Crash2100
7 Comments
 
LVL 11

Expert Comment

by:supunr
ID: 8235833
Private Sub CompareAndCopyOrDelete()
     Dim Folder1 as String
     Dim Folder2 as String
     Dim FilesList() as String
     Dim FilesListStr as string
     Dim FilesCount as long    
     Dim FileName as String
     Dim i as long    

     Folder1 = "C:\TestFolder1\"
     Folder2 = "C:\TestFolder2\"

     ' remember all the file names in folder1
     FilesCount = 0
     FilesListStr = ""
     FileName = Dir(Folder1 & "*.*")
     Do while FileName <> ""
          Redim Preserve FilesList(FilesCount+1)
          FilesList(FilesCount) = FileName
          FilesListStr = FilesListStr & "|" & FileName
          FilesCount = FilesCount + 1
          FileName = Dir
     Loop
     ' now copy any missing files in folder 2
     For i = 0 to FilesCount - 1
          if (Dir(Folder2 & FilesList(i)) = FileName) then
               FileCopy Folder1 & FilesList(i), Folder2 & FilesList(i)
          end if
     Loop
     ' now delete files from folder2 missing in folder1
     FileName = Dir(Folder2 & "*.*")
     Do while FileName <> ""
          if (Instr(1, FilesListStr, "|" & FileName) = 0) then ' file not found
               Kill Folder2 & FileName
          end if
          FileName = Dir
     Loop
End Sub

' NOTE: Above function will only copy files in a given directory only, not the sub directories.
' Good Luck!
0
 
LVL 27

Expert Comment

by:Dabas
ID: 8236824
Just in case you do not feel like reinventing the wheel, I would recommend Total Commander (used to be Windows Commander).
It does just that and much more.

Just try it out at

http://www.ghisler.com/

Dabas
0
 
LVL 18

Author Comment

by:Crash2100
ID: 8277307
Well, I re-invented the wheel!

I found this procedure called RecurseTree in my VB Developer's Workshop book.  It goes through a folder getting a list of files then does the same for subfolders.
http://poluxlilet.free.fr/Codes%20disk.htm

After working on it for two days I was able to come up with this that appears to do just what I wanted.  But thanks for the help!


Option Explicit

Public Path1 As String
Public Path2 As String

Private Sub cmdCopy_Click()
    Path1 = dirInput.Path
    Path2 = dirOutput.Path
   
    'If it's a Drive Root, it will append an extra '\' to the end of the string
    If Len(Path1) = 3 Then Path1 = Replace(Path1, "\", "")
    If Len(Path2) = 3 Then Path2 = Replace(Path2, "\", "")
   
    If Path1 Like Path2 & "*" Or Path2 Like Path1 & "*" Then
        MsgBox "Folders being copied from or to cannot be contained within each other.", vbCritical
        Exit Sub
    End If
   
    Text1 = ""
    CopyFolders Path1
    DeleteFolders Path2
End Sub



Private Sub Form_Load()
    'Set the Refrence "Microsoft Scripting Runtime" From Project Menu
    dirInput.Path = "E:\Documents and Settings\Jeff\Desktop\backup program\test11"
    dirOutput.Path = "E:\Documents and Settings\Jeff\Desktop\backup program\test22"
End Sub


Sub CopyFolders(strParentFolder As String)
    Dim fsCurrentFolder, fsSubFolders, fsCurrentFile, fsFiles
    Dim fs As New Scripting.FileSystemObject
    Dim strFile1 As String
    Dim strFile2 As String

    Set fsCurrentFolder = fs.GetFolder(strParentFolder)
    Set fsSubFolders = fsCurrentFolder.SubFolders
   
    For Each fsCurrentFile In fsCurrentFolder.Files

        strFile1 = strParentFolder & "\" & fsCurrentFile.Name
        strFile2 = Replace(strParentFolder & "\" & fsCurrentFile.Name, Path1, Path2)
       
        'If the file exists, compare it's modified date with the other
        'If it's different re-copy the file
        'If the file doesn't exist, copy the file
        If fs.FileExists(strFile2) Then
            If DateDiff("s", FileDateTime(strFile1), FileDateTime(strFile2)) <> 0 Then
               
                Text1 = Text1 & vbCrLf & "UPDATE FILE:  COPY " & strFile1 & " to " & strFile2
                fs.CopyFile strFile1, strFile2, True
               
                'Text1 = Text1 & vbCrLf & vbTab & FileDateTime(strFile1)
                'Text1 = Text1 & vbCrLf & vbTab & FileDateTime(strFile2)
            End If
        Else
            Me.Show
            Text1 = Text1 & vbCrLf & "COPY FILE:" & vbTab & strFile1 & " to " & strFile2 'strParentFolder & "\" & fsCurrentFile.Name
            fs.CopyFile strFile1, strFile2, False
        End If
    Next
   
   
   
    For Each fsCurrentFolder In fsSubFolders
        'If the folder already exists in Folder2, process the files
        'If it doesn't exist, just copy Folder1 to Folder2
       
        strFile1 = strParentFolder & "\" & fsCurrentFolder.Name
        strFile2 = Replace(strParentFolder & "\" & fsCurrentFolder.Name, Path1, Path2)

        If fs.FolderExists(strFile2) Then
            CopyFolders strFile1 'strParentFolder & "\" & fsCurrentFolder.Name
            'MsgBox "copyfolders"
        Else
            Text1 = Text1 & vbCrLf & "COPY FOLDER:" & vbTab & strFile1 & " to " & strFile2 'strParentFolder & "\" & fsCurrentFolder.Name
            fs.CopyFolder strFile1, strFile2, False
        End If
    Next
   
End Sub


Sub DeleteFolders(strParentFolder As String)
    Dim fsCurrentFolder, fsSubFolders, fsCurrentFile, fsFiles
    Dim fs As New Scripting.FileSystemObject
    Dim strFile1 As String
    Dim strFile2 As String

    Set fsCurrentFolder = fs.GetFolder(strParentFolder)
    Set fsSubFolders = fsCurrentFolder.SubFolders
   
    For Each fsCurrentFile In fsCurrentFolder.Files
        strFile1 = Replace(strParentFolder & "\" & fsCurrentFile.Name, Path2, Path1)
        strFile2 = strParentFolder & "\" & fsCurrentFile.Name
       
        'If the file exists in Folder2 and Not Folder1, delete the file
        If fs.FileExists(strFile2) And Not (fs.FileExists(strFile1)) Then
                Text1 = Text1 & vbCrLf & "DELETE FILE:" & vbTab & strFile2
                fs.DeleteFile strFile2
        End If
    Next
   
   

    For Each fsCurrentFolder In fsSubFolders
        'If the folder exists in both Folder2 and Folder1, process the files and sub folders
        'If the folder exists in Folder2 and not Folder1, delete the folder
                   
        strFile1 = Replace(strParentFolder & "\" & fsCurrentFolder.Name, Path2, Path1)
        strFile2 = strParentFolder & "\" & fsCurrentFolder.Name
       
        If fs.FolderExists(strFile1) Then
            'Re-run the routine for the sub folders
            DeleteFolders strFile2
        Else
            Text1 = Text1 & vbCrLf & "DELETE FOLDER:" & vbTab & strFile2
            fs.DeleteFolder strFile2
        End If
    Next
   
End Sub

0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Expert Comment

by:DigitalXtreme
ID: 8277750
Crash2100 has requested that this question be PAQ'ed and points refunded. If there are any objections to this request please post them here within 72 hours. Thank You :)

DigitalXtreme
CS Moderator
0
 

Expert Comment

by:CleanupPing
ID: 8531295
Hi Crash2100,
This old question (QID 20568236) needs to be finalized -- accept an answer, split points, or get a refund.  Please see http://www.cityofangels.com/Experts/Closing.htm for information and options.
0
 
LVL 18

Author Comment

by:Crash2100
ID: 8532835
they were supposed to have put it in PAQ a month ago
0
 

Accepted Solution

by:
DigitalXtreme earned 0 total points
ID: 8533596
Sorry, it must have slipped off my list somehow.

question PAQ'ed and points refunded.

DigitalXtreme
CS Moderator
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month12 days, 19 hours left to enroll

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question