Program to search array of file extensions and copy elsewhere

[bondra33]

I have a file structure of multiple folders with a maximum subfolder structure of 2 drop down folders. Instead of searching through each folder to determine whether to keep the file or delete it, I am looking for a program to scan the folders/files for certain file extensions. I would then like those files to be copied to an output directory of the same tree structure. If anyone knows of small program capable of completing this simple task, please let me know.

Thanks for your help

 

[RobertMottram]

This is a very round about way of doing this, but I have managed to use this before to do a similar thing. In our problem we wanted to rename the directories, but it is all about the same.
I start by using the DOS DIR command and redirecting it into a file. For example

DIR *.EXE /s /b > filelist.txt

/s - Include subdirectories
/b - Bare Format

This will produce a text file with the full file name and path, one per line, of each of the found files. For Example
c:\windows\win.exe
c:\myFiles\MyExec.exe
etc

You can then write a VB (or other) program to read this file line by line then running split on it (aryfolders = split(inputline, "/&quot which for each line will give you and array of all the paths.
The tricky bit is then creating the same path. If all these files will always be the same distance down it will not be too bad.

Read lines into inputline on at a time
I am presuming all the files are 2 directories down from the root of you search

strNewPathRoot = "c:\newpath"  'put in here where you want to copy the files to
aryFolders = split(inputline, "/")
intDepth = Ubound(aryFolders)
strNewFileName = strNewPathRoot & "\" & aryFolders(intDepth -2) & "\" & AryFolders(intdepth -1) & "\" & aryFolders(intdepth)

Now we have the old and new path we can do a copy like this

FileCopy inputline, strNewFileName

This will copy the file. VB also has a move command if it is more use.

If these files could be any level down in the directory structure, this is more complex but not imposible!
Infact quite easy now have thought for a second just truing to explain it is hard.

You will know that the top level directory you want to move from will always be the same number of directories down, so in c:\windows\system\help\vb\readmes\ the directory vb will aways be 4 directories down. this means you can make the new path by using this....

strNewFileName = strNewPath & "\" & aryFolders(4) & "\" & aryFolders(5) & aryFolders(6)

You will have to check how far down the directory structure the file is using UBOUND(aryFolders) to know how many of the aryFolders you need.

I hope this makes some sort of sence to you and you might be able to us it to give you what you want.

Rob

 

[CajunCenturion]

Below is a general purpose utility which will find either the first, or all files in and beneath the parent directory which meet a given file specification. It returns a collection which contains a list of the matching file(s).


Private Sub GetFileCollection()

Dim lCol_FoundFiles As Collection
Dim lBol_FoundOne As Boolean
Dim lStr_Pattern As String
Dim lStr_FileSpec As String
Dim lInt_Idx As Integer
Dim lStr_ThisChar As String
Dim lStr_ParentDir As String

lStr_ParentDir = "c:\Program Files\"
lStr_FileSpec = "*.exe"

lStr_Pattern = ""
For lInt_Idx = 1 To Len(lStr_FileSpec)
lStr_ThisChar = Mid(lStr_FileSpec, lInt_Idx, 1)
Select Case lStr_ThisChar
Case "*"
lStr_Pattern = lStr_Pattern & "\w*"
Case "?"
lStr_Pattern = lStr_Pattern & "."
Case "."
lStr_Pattern = lStr_Pattern & "\."
Case Else
lStr_Pattern = lStr_Pattern & "[" & UCase(lStr_ThisChar) & lStr_ThisChar & "]"
End Select
Next lInt_Idx
lStr_Pattern = lStr_Pattern & "$"

Set lCol_FoundFiles = New Collection
lBol_FoundOne = FindFiles(lCol_FoundFiles, lStr_ParentDir, lStr_Pattern, True)
If (lBol_FoundOne = True) Then
For lInt_Idx = 1 To lCol_FoundFiles.Count
' <process file: lCol_FoundFiles.Item(lint_idx) >
Next lInt_Idx
End If

End Sub

'-------------------------------------------------------

Public Function FindFiles(rCol_FileList As Collection, rStr_Parent As String, rStr_Pattern As String, rBol_FindAll As Boolean) As Boolean

Dim lStr_CheckFile As String
Dim lInt_Idx As Integer
Dim lBol_FileFound As Boolean
Dim lInt_FileType As Integer
Dim lCol_SubDirs As New Collection
Dim lReg_FileString As New RegExp

If (Right(rStr_Parent, 1) <> &quot;\&quot Then
rStr_Parent = rStr_Parent & &quot;\&quot;
End If

lReg_FileString.Pattern = rStr_Pattern
lStr_CheckFile = Dir(rStr_Parent, vbDirectory)
lBol_FileFound = False

While (Len(lStr_CheckFile) > 0)
If (UCase(lStr_CheckFile) = &quot;PAGEFILE.SYS&quot Then
lStr_CheckFile = Dir
Else
If (Left(lStr_CheckFile, 1) = &quot;.&quot Then
lStr_CheckFile = Dir
Else
lInt_FileType = GetAttr(rStr_Parent & lStr_CheckFile) And vbDirectory
If (lInt_FileType = vbDirectory) Then
lCol_SubDirs.Add (rStr_Parent & lStr_CheckFile)
lStr_CheckFile = Dir
Else
If (lReg_FileString.Test(lStr_CheckFile) = True) Then
rCol_FileList.Add rStr_Parent & lStr_CheckFile
lBol_FileFound = True
lStr_CheckFile = IIf((rBol_FindAll = True), Dir, &quot;&quot
Else
lStr_CheckFile = Dir
End If
End If
End If
End If
Wend

If ((lBol_FileFound = False) Or (rBol_FindAll = True)) Then
lInt_Idx = 1
While (lInt_Idx <= lCol_SubDirs.Count)
lBol_FileFound = FindFiles(rCol_FileList, lCol_SubDirs.Item(lInt_Idx), rStr_Pattern, rBol_FindAll)
If ((lBol_FileFound = False) Or (rBol_FindAll = True)) Then
lInt_Idx = lInt_Idx + 1
Else
lInt_Idx = lCol_SubDirs.Count + 1
End If
Wend
End If

FindFiles = lBol_FileFound

End Function
Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein