PDA

View Full Version : Checking if any files in folder are in another



Directlinq
11-06-2009, 05:41 PM
Hi is it possible touse purely vba to look at all the .mpg files in a folder and check if any of them exist in another folder.

Please if anybody could help me ive spent 8 hours on this so far its driving me nuts.

Many Thanks

OBP
11-07-2009, 05:53 AM
Yes you can do this by Automatically putting the Full Path of the File names in to a table and then use a "Find Duplicates" query.
Is that what you want to do?

geekgirlau
11-09-2009, 06:46 PM
Sub CheckFiles()
Dim strOriginal() As String
Dim strDuplicate As String
Dim strFile As String
Dim l As Long
Dim blnFound As Boolean

Const cstrPathOriginal As String = "C:\Original Folder\"
Const cstrPathCompare As String = "C:\Duplicate Folder\"


On Error GoTo ErrHandler
' check that the folders exist
If Dir(cstrPathOriginal, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & cstrPathOriginal, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

If Dir(cstrPathCompare, vbDirectory) = "" Then
MsgBox "This folder does not exist:" & vbCrLf & vbCrLf & cstrPathCompare, vbExclamation, _
"Folder Not Found"
GoTo ExitHere
End If

' capture all the filenames found in the original folder
strFile = Dir(cstrPathOriginal & "*.xls", vbNormal)

Do Until strFile = ""
ReDim Preserve strOriginal(0 To l)
strOriginal(l) = strFile
l = l + 1
blnFound = True

strFile = Dir()
Loop

' check whether any files were found
If blnFound = False Then
MsgBox "No matching files were found in the original folder", vbInformation, "No Files Found"
Else
' capture filenames also found in the comparison folder
For l = 0 To UBound(strOriginal)
If Dir(cstrPathCompare & strOriginal(l), vbNormal) <> "" Then
strDuplicate = strDuplicate & vbCrLf & strOriginal(l)
End If
Next l

If strDuplicate <> "" Then
MsgBox "The following duplicate files were found:" & vbCrLf & strDuplicate, vbInformation, _
"Duplicates Found"
Else
MsgBox "No duplicate files were found", vbInformation, "No Duplicates Found"
End If
End If

ExitHere:
Exit Sub
ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error (" & Err.Number & ")"
Resume ExitHere
End Sub

OBP
11-10-2009, 05:09 AM
Show off :devil2: :thumb

geekgirlau
11-11-2009, 03:54 PM
:tease: