?
Solved

Comparing contents two folders

Posted on 2003-03-30
7
Medium Priority
?
279 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

771 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