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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.