Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 392
  • Last Modified:

Folder Comparison

Hi,

we were using a "folder comparison tool" along with a inhouse application. But of late, the business users have asked the "folder comparison" functionality to be part of the inhouse application itself.

so can someone please provide me the code as to how we can achieve this in VB6?

basically given two folders, we need to recursively list out all the "folders", "sub folders", "files" on the left hand side for the first selected folder. The corresponding details of the second folder must be shown on the right hand side. we plan to use "list view control" for this purpose.
0
expertfan
Asked:
expertfan
  • 12
  • 11
  • 2
1 Solution
 
expertfanAuthor Commented:
can someone please post a code which will do the listing on "list view control".
-------------------------------------
0
 
JackOfPHCommented:
here are a simple example
Option Explicit

Private Sub Form_Load()
Dim fileName As String


fileName = Dir("c:*.*")
Do Until fileName = ""
     ListView1.ListItems.Add().Text = fileName
   
   fileName = Dir
Loop
End Sub
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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.

 
expertfanAuthor Commented:
HI JackOfPH,

I am looking at code which will list the "folders", "subfolder" and "files" recursively for a given parent folder.
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Private Sub Form_Load()
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "Folder Name", 2000
    ListView1.ColumnHeaders.Add , , "Folder Path", 3000
    ListView1.View = lvwReport
End Sub

Private Sub Command1_Click()
    ListView1.ListItems.Clear
    ScanFolders "D:\your_folder_name" 'Give your folder path
End Sub

Private Sub ScanFolders(Path As String)
'Dim oFso As New FileSystemObject
Dim oFso
Dim oFld
Dim oTFld
Dim oLst As ListItem
    Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next 'To handle permission denied error
    If Not oFso.FolderExists(Path) Then
        Set oFso = Nothing
        Exit Sub
    End If
    Set oFld = oFso.GetFolder(Path)
    Set oLst = ListView1.ListItems.Add(, , oFld.Name)
        oLst.SubItems(1) = oFld.Path
   
    For Each oTFld In oFld.SubFolders
        ScanFolders oTFld.Path
        DoEvents
    Next
    Set oFso = Nothing
    Err.Clear
End Sub
0
 
expertfanAuthor Commented:
hi shijusn,

this is good. can some one now please provide the code to compare two folders[folder1 and folder2] and list out

1. the ones which exist on left only in say GREEN COLOR
2. the ones which exist on right side only in say BLUE COLOR
3. if foldernames match but the number of files/subfolders under them is different then it should be in RED COLOR
4. the remaining entries in BLACK COLOR
0
 
Shiju SasidharanAssoc Project ManagerCommented:
What do u mean by left and right side?
u mean to say, two list view controls on left and right?
0
 
expertfanAuthor Commented:
yes, two list view controls. so that we can compare two folders.
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Private Sub Form_Load()
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "Folder Name", 2000
    ListView1.ColumnHeaders.Add , , "Folder Path", 3000
    ListView1.View = lvwReport
   
    ListView2.ColumnHeaders.Clear
    ListView2.ColumnHeaders.Add , , "Folder Name", 2000
    ListView2.ColumnHeaders.Add , , "Folder Path", 3000
    ListView2.View = lvwReport
End Sub
Private Sub Command1_Click()
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    ScanFolders "D:\Source_Folder", "D:\Source_Folder", "D:\Dest_Folder"
End Sub
Private Sub ScanFolders(Path As String, SourcePath, DestPath As String)
Dim oFso
Dim oFld
Dim oTFld
Dim oLst As ListItem
Dim sPath As String
    Set oFso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next 'Uncomment this line to handle permission denied error

    If Not oFso.FolderExists(Path) Then
        Set oFso = Nothing
        Exit Sub
    End If
    Set oFld = oFso.GetFolder(Path)
    For Each oTFld In oFld.SubFolders
        Set oLst = ListView1.ListItems.Add(, , oTFld.Name)
            oLst.SubItems(1) = oTFld.Path
           
        sPath = Replace(oTFld.Path, SourcePath, "")
        sPath = DestPath & sPath
        If Not oFso.FolderExists(sPath) Then
            Set oLst = ListView2.ListItems.Add(, , "** Missing **")
                oLst.SubItems(1) = sPath
            oLst.ForeColor = vbRed
            oLst.ListSubItems(1).ForeColor = vbRed
        Else
            Set oLst = ListView2.ListItems.Add(, , oTFld.Name)
                oLst.SubItems(1) = oTFld.Path
        End If
        ScanFolders oTFld.Path, SourcePath, DestPath
        DoEvents
    Next
    Set oFso = Nothing
    Err.Clear
End Sub
0
 
expertfanAuthor Commented:
hi shijusn,

this is showing the 'folders' that exist on leftside and mentions whats 'missing' on right side.

but does not 'list' the folders that exist on rightside but is 'missing' on left side.
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Private Sub Command1_Click()
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    ScanFolders "D:\Source_Folder", "D:\Source_Folder", "D:\Dest_Folder", ListView1, ListView2
    ScanFolders "D:\Dest_Folder", "D:\Dest_Folder", "D:\Source_Folder", ListView2, ListView1
End Sub

Private Sub ScanFolders(Path As String, SourcePath As String, DestPath As String, LvSource As ListView, LvDest As ListView)
Dim oFso
Dim oFld
Dim oTFld
Dim oLst As ListItem
Dim sPath As String
    Set oFso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next 'Uncomment this line to handle permission denied error

    If Not oFso.FolderExists(Path) Then
        Set oFso = Nothing
        Exit Sub
    End If
    Set oFld = oFso.GetFolder(Path)
    For Each oTFld In oFld.SubFolders
   
        Set oLst = LvSource.ListItems.Add(, , oTFld.Name)
            oLst.SubItems(1) = oTFld.Path
           
        sPath = Replace(oTFld.Path, SourcePath, "")
        sPath = DestPath & sPath
        If Not oFso.FolderExists(sPath) Then
            Set oLst = LvDest.ListItems.Add(, , "** Missing **")
                oLst.SubItems(1) = sPath
            oLst.ForeColor = vbRed
            oLst.ListSubItems(1).ForeColor = vbRed
        Else
            Set oLst = LvDest.ListItems.Add(, , oTFld.Name)
                oLst.SubItems(1) = oTFld.Path
        End If
        ScanFolders oTFld.Path, SourcePath, DestPath, LvSource, LvDest
        DoEvents
    Next
    Set oFso = Nothing
    Err.Clear
End Sub
0
 
expertfanAuthor Commented:
hi shijusn,

this is good improvement, but all the folders are getting repeated twice.
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Well, you needed two folders to be compared.
Its not repeated twice, actually its showing the missing folders
If you look at the second column, then you can understand all the paths are different.
0
 
expertfanAuthor Commented:
See i am comparing folder-1 the folders under this are

one
two
three
four
five

the folder-2 contains the following subfolders.

one
two
three
six
seven.

so the result should be like this
---------------------
one                               one
two                               two
three                             three
four                               ** missing **
five                                ** missing **
**missing**                  six
**missing**                  seven

-----------------
but the code you gave gives 10 rows instead of 7 rows
0
 
Shiju SasidharanAssoc Project ManagerCommented:
;-) ok done

Private Sub ScanFolders(Path As String, SourcePath As String, DestPath As String, LvSource As ListView, LvDest As ListView)
Dim oFso
Dim oFld
Dim oTFld
Dim oLst As ListItem
Dim sPath As String
    Set oFso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next 'Uncomment this line to handle permission denied error

    If Not oFso.FolderExists(Path) Then
        Set oFso = Nothing
        Exit Sub
    End If
    Set oFld = oFso.GetFolder(Path)
    For Each oTFld In oFld.SubFolders
   
        Set oLst = LvSource.ListItems.Add(, , oTFld.Name)
            oLst.SubItems(1) = oTFld.Path
           
        sPath = Replace(oTFld.Path, SourcePath, "")
        sPath = DestPath & sPath
        If Not oFso.FolderExists(sPath) Then
            Set oLst = LvDest.ListItems.Add(, , "** Missing **")
                oLst.SubItems(1) = sPath
            oLst.ForeColor = vbRed
            oLst.ListSubItems(1).ForeColor = vbRed
        End If
        ScanFolders oTFld.Path, SourcePath, DestPath, LvSource, LvDest
        DoEvents
    Next
    Set oFso = Nothing
    Err.Clear
End Sub
0
 
expertfanAuthor Commented:
yes now its showing 7 entries only on each side......but the left side and right side do no map one to one like i had mentioned above in the requirement.

the output is coming as follows....which is pretty confusing.

five                      **misssing**
four                     **misssing**
one                      one
three                    seven
two                      six
**misssing**       three
**missing**         two

but the output should be

one                               one
two                               two
three                             three
four                               ** missing **
five                                ** missing **
**missing**                  six
**missing**                  seven
0
 
Shiju SasidharanAssoc Project ManagerCommented:
@expertfan
That depends on the folder names
Are you expecting result in sorted order?
Format you specified is not in sorted order, infact its in counting order one two three
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Hope you can do rest of the formating and sorting things
0
 
expertfanAuthor Commented:
hi shijusn,

it need not be really sorted, but the leftside should have mapping to the right.....thats really what i am looking at.

because with the code you currently gave me, the left side does not map to the right side.
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Is it so?
Please  verify the path specified in the listview

Have u noticed second column of each list view? they are mapped correctly
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Sorry try after this

Private Sub Command1_Click()
    ListView1.Sorted = True
    ListView1.SortKey = 1
    ListView2.SortKey = 1
    ListView1.ListItems.Clear
    ListView2.ListItems.Clear
    ScanFolders "D:\Source_Folder", "D:\Source_Folder", "D:\Dest_Folder", ListView1, ListView2
    ScanFolders "D:\Dest_Folder", "D:\Dest_Folder", "D:\Source_Folder", ListView2, ListView1
End Sub
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Include this one too
>>ListView2.Sorted = True
0
 
expertfanAuthor Commented:
yes, i am comparing the "left side listview" with "right side listview" and following is the current output. hope this clarifies...

the output is coming as follows....which is pretty confusing.

five                      **misssing**
four                     **misssing**
one                      one
three                    seven
two                      six
**misssing**       three
**missing**         two

------------
if you observer row 1, 2, 3 are fine. but rows 4,5,6,7 are not showing correct mappings.
for example...
row-4 on leftside shows "three" but rightside shows "seven"
row-5 on leftside shows "two" and rightside shows "six"


0
 
expertfanAuthor Commented:
hi shijusn,

this works great !!
0
 
Shiju SasidharanAssoc Project ManagerCommented:
Cool , finally you are happy.

Thanks for the grade :-)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 12
  • 11
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now