#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 557
Default Match Files

hi all, I have file names in column A and I want macro which should
match these file names with the files in folder "C:\Document" and if
there is any file name which don’t match then macro should highligt
that cell.
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default Match Files

This should work if you have your files in the sheet in column A, starting
in row 1.
Just alter this line of code:
arr1 = Range(Cells(1), Cells(52, 1))
And of course the search parameters.


Sub FindNonMatching()

Dim i As Long
Dim arr1
Dim arr2
Dim lFileCount As Long
Dim lDirCount As Long
Dim coll As Collection

Set coll = New Collection

'list of files in the sheet
arr1 = Range(Cells(1), Cells(52, 1))

'files from the folder
arr2 = FindFiles("C:\Test\", _
"*.xls", _
False, _
lFileCount, _
lDirCount)

'files found in folder to collection
For i = 1 To UBound(arr2)
coll.Add i, arr2(i)
Next i

'find the non-matching files and mark the cells
On Error Resume Next
For i = 1 To UBound(arr1)
coll.Add i, arr1(i, 1)
If Err.Number = 0 Then
Cells(i, 1).Interior.ColorIndex = 20
Else
Err.Clear
End If
Next i

End Sub


Function FindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean, _
Optional lFileCount As Long, _
Optional lDirCount As Long) As String()

'will produce a 1-based 1-D array with all the found filepaths
'---------------------------------------------------------------
'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Long 'Number of directories in this strPath.
Dim i As Long
Static strStartDirName As String
Static collFiles As Collection
Dim arrFinal

On Error GoTo sysFileERR

If Right$(strPath, 1) < "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
strStartDirName = strPath
Set collFiles = New Collection
End If

'Search for subdirectories.
nDir = 0

ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so on.

Do While Len(strDirName) 0
'Ignore the current and encompassing directories.
If (strDirName < ".") And (strDirName < "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop

'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) < 0
lFileCount = lFileCount + 1
collFiles.Add Item:=strPath & strFileName, Key:=CStr(lFileCount)
strFileName = Dir() 'Get next file.
Wend

If bSubFolders Then
'If there are sub-directories..
If nDir 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSubFolders, _
lFileCount, _
lDirCount
Next
End If

'searching the supplied main directory is done last
'so that is when we redim and supply the produced array
'------------------------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
'change the collection to an array
'---------------------------------
ReDim arrFinal(1 To lFileCount) As String
For i = 1 To lFileCount
arrFinal(i) = collFiles(i)
Next
FindFiles = arrFinal
End If
Else
ReDim arrFinal(1 To lFileCount) As String
For i = 1 To lFileCount
arrFinal(i) = collFiles(i)
Next
FindFiles = arrFinal
End If

ABORTFUNCTION:
Exit Function
sysFileERR:
If Right$(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
Resume ABORTFUNCTION
End If

End Function


RBS



"K" wrote in message
...
hi all, I have file names in column A and I want macro which should
match these file names with the files in folder "C:\Document" and if
there is any file name which don’t match then macro should highligt
that cell.

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to MATCH or VLOOKUP & copy using 2 excel files Sandeep Excel Worksheet Functions 3 October 25th 08 06:29 PM
match item in 2 excel files [email protected] Excel Discussion (Misc queries) 0 April 25th 08 03:38 AM
Using match in vba.. with various files nance Excel Programming 2 December 31st 05 11:46 PM
Match 10 xls files Tom Lemmens Excel Discussion (Misc queries) 0 October 26th 05 08:10 AM
Data from other files & Match? shital shah Excel Programming 2 March 5th 05 06:47 PM


All times are GMT +1. The time now is 10:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"