Windows 7 - copy text files only from all subfolders within a folder to a another folder

Asked By Yasser Elzefzaf on 25-May-08 04:31 PM
Dear All,



i'm new in vb scripting and a task was assigned to me so as to creat a vb script that performs the following:



if i have a folder whose path is: "D:\Test"

and it containes more than one sub folder as: "D:\Test\Sub1", "D:\Test\Sub2", etc..



the sub folders containes different types of files



what i want to do is to copy only all text files in all the sub folders under "D:\Test", to a new folder "D:\Text" without copying any of the sub folders.



could any one help?



thanks in advance




Pegasus \(MVP\) replied on 25-May-08 05:04 PM
This is a standard maintenance task that can most easily be
performed with a two-line batch file:
@echo off
cd /d "d:\Test"
for /d %%a in (*.*) do xcopy /y "%%a\*.txt" "D:\Text\%%a\"

It's fairly easy to do in with VB Script too but it requires about
six times as much code.
YasserElzefza replied on 26-May-08 01:15 AM
thanks for the reply, but i know how to do it using a batch file, what is
required is to accomplish this task using a vb script

any Idea
Pegasus \(MVP\) replied on 26-May-08 04:15 AM
Here is the basic idea:
1. Use the File System Object (oFSO) to get all folder names in d:\Test.
2. Use the CreateFolder method of the oFSO to create new folders in d:\Text.
3. Use the CopyFile method of the oFSO to copy all text files from
d:\Test to d:\Text.

If you post your script based on the above framework then someone
will provide further assistance if required. I also recommend that you
download the help file script56.chm - it contains detailed descriptions
of all basic VB Script commands.
James Whitlow replied on 26-May-08 12:02 PM
Try the code below, but be aware of it's limitations. It is copying (as
specified) instead of moving the files, so every time the code is executed,
all files are re-copied. It also blindly overwrites files in the root
directory, regardless of 'Date Modified'. Files in any sub-folder will
always overwrite the root folder. Same thing for identically named files in
the sub-folders. The last file encountered will always win. If you wish to
change this behavior & would like assistance, reply to this thread.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sRoot = "R:\DTest\"
sExt  = "txt"

If Not Right(sRoot, 1) = "\" Then sRoot = sRoot & "\"

Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each sSub in EnumFolder(sRoot)
For Each oFile in oFSO.GetFolder(sSub).Files
If LCase(oFSO.GetExtensionName(oFile)) = sExt Then
oFSO.CopyFile oFile, sRoot, True
End If
Next
Next

Function EnumFolder(ByVal vFolder)
Dim oFSO, oFolder, sFldr, oFldr
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not IsArray(vFolder) Then
If Not oFSO.FolderExists(vFolder) Then Exit Function
sFldr = vFolder
ReDim vFolder(-1)
Else sFldr = vFolder(UBound(vFolder))
End If
Set oFolder = oFSO.GetFolder(sFldr)
For Each oFldr in oFolder.Subfolders
ReDim Preserve vFolder(UBound(vFolder) + 1)
vFolder(UBound(vFolder)) = oFldr.Path
EnumFolder vFolder
Next
EnumFolder = vFolder
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Pegasus \(MVP\) replied on 26-May-08 12:27 PM
It seems I was a little conservative with my estimate. I assume
that your VB Script solution is functionally equivalent to my
batch file solution. The size of my batch file is 88 bytes, the size
of your script solution 882 bytes, ten times as much, probably
requiring then times the development, debugging and maintenance
time. There appears to be a bug in it already - the OP wanted
c:\Text as a target folder. Your script copies all files into c:\Test,
which is not quite the same thing.

Still, it's a VB Script solution which is what the OP wanted!
James Whitlow replied on 26-May-08 12:50 PM
I think it is, but it would be much easier to fix the date problem in
your batch code (by simply adding the '/D' switch to XCOPY) than it would be
in my VBScript code.


I absolutely agree! A VBScript solution is not always the best.solution
when a simple batch will do.


Thanks for pointing this out. I normally do a quick code test in my ram
disk before posting. Sometimes I forget to change the path back.  So, to the
OP, please change the folder in the first line [sRoot = "R:\DTest\"] to
YasserElzefza replied on 26-May-08 01:00 PM
first of all thank you so much for such great one, it really worked ;)

i managed the destination folder to which the files will be copied to so as
not to overwrite the rrot one

but i would like to ask something about the below script (the one i tried to
develop) it didn't work, abd every time i try to debug it , it returns
different error

HUG if you don't mind to help:

--------------------------------------------
My Script:
----------------------------------------------

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("D:\Test")
Set colFiles = objFSO.GetFolder(subFolder).Files



AllFolders objFolder

Sub AllFolders (Folder)

For Each SubFolder in Folder.Subfolders

CopyTextFiles subfolder

AllFolders Subfolder

Next
End Sub


Sub CopyTextFiles (subFolder)

For Each objFile in colFiles
arrSplitName = Split(objFile.Name, ".")
strExtension = arrSplitName(UBound(arrSplitName) - 1)
If strExtension = "txt" Then
objFSO.CopyFile objFile.Path, "D:\Text\"
Wscript.Echo objFSO.Name
End If
Next

End Sub

Wscript.Echo "Done..."
--------------------------------------------------------------------------------------------------------------
James Whitlow replied on 26-May-08 05:09 PM
Copying and running your script as posted gives me an error on line 3:


The problem appears to be that you are trying to set 'colfiles' to the
files in the directory defined by 'subfolder', but you have not yet set the
value of 'subfolder'. I think you meant to use 'objFolder' here.

Once I change line 3 to [Set colFiles =
objFSO.GetFolder(objFolder).Files] , the script runs, but does not actually
do anything because of an error in the line that gets the file extension:

Change it **From**: strExtension = arrSplitName(UBound(arrSplitName) -
1)
**To**: strExtension = arrSplitName(UBound(arrSplitName) )

With these changes, you will get the files in the root of "D:\Test", but
not the subfolders since you are not recalculating 'colFiles' for each
subfolder. If you add the line:

Set colFiles = objFSO.GetFolder(subFolder).Files

...just inside "Sub CopyTextFiles", it should give you the results you
are looking for.

Lastly, the code is not copying the text files from the root (I assume
you want this). Just add the line:

CopyTextFiles objFolder

...just about the [AllFolders objFolder] line.

With these changes, your code should do exactly what you want, while
mine will not (see below). If you don't want the text file in the root and
only the text files inside the subfolders, leave this out.

My originally posted code had a mistake in it that caused it not to
carry forward any subfolders below the first level  in the array. I have
corrected it and posted it below.

Your code is enumerating the subdirectories and copying the files as it
goes. Mine is creating a complete array of the subdirectories first and then
walking the array. For what you are doing, your code is going to be more
compact and easier to read. I would personally suggest using your code. I
have, however, posted a corrected version of mine below.

Also, please note, that it looking at your code here, I realized that I
misread your original post and was not doing exactly what you wanted. In
your original message you stated you wanted all text file from 'D:\Test' to
go to 'D:\Text'. I did not notice the 's' changing to 'x' and falsly
concluded that you wanted all of the file from the subfolders of the
specified folder copied to the root of that folder. Sorry about that, my
mistake.

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sSourceDir = "D:\Test\"
sDestDir = "D:\Text\"
sExt  = "txt"

If Not Right(sSourceDir, 1) = "\" Then sSourceDir = sSourceDir & "\"
If Not Right(sDestDir, 1) = "\" Then sDestDir = sDestDir & "\"

Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each sSub in EnumFolder(sSourceDir)
For Each oFile in oFSO.GetFolder(sSub).Files
If LCase(oFSO.GetExtensionName(oFile)) = sExt Then
oFSO.CopyFile oFile, sDestDir, True
End If
Next
Next

Function EnumFolder(ByRef vFolder)
Dim oFSO, oFolder, sFldr, oFldr
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not IsArray(vFolder) Then
If Not oFSO.FolderExists(vFolder) Then Exit Function
sFldr = vFolder
ReDim vFolder(0)
vFolder(0) = oFSO.GetFolder(sFldr).Path
Else sFldr = vFolder(UBound(vFolder))
End If
Set oFolder = oFSO.GetFolder(sFldr)
For Each oFldr in oFolder.Subfolders
ReDim Preserve vFolder(UBound(vFolder) + 1)
vFolder(UBound(vFolder)) = oFldr.Path
EnumFolder vFolder
Next
EnumFolder = vFolder
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Pegasus \(MVP\) replied on 26-May-08 05:14 PM
I could not quite follow the logic in your script. Parts of it
appeared to recursive. Note also the following points:
- Avoid embedding important constants deep inside in your code.
Put    them right up the top where they are highly visible. This
makes maintenance much, much easier.
- Keep your main routine in one contiguous block. Spreading
it before, in between and after your subroutines gets
confusing.
Try this script. It is fully tested.

01. Source = "D:\Temp\"
02. Target = "D:\Text\"
03. ext    = ".txt"
04.
05. Set objFSO = CreateObject("Scripting.FileSystemObject")
06. If Not objFSO.FolderExists(Target) then objFSO.CreateFolder(Target)
07.
08. For Each sFolder In objFSO.GetFolder(Source).SubFolders
09.  CopyTextFiles Source & sFolder.Name
10. Next
11. WScript.Echo "Done..."
12.
13. Sub CopyTextFiles (subFolder)
14.  For Each objFile In objFSO.GetFolder(subFolder).Files
15.   If LCase(Right(objFile.Name, 4)) = ext _
16.   Then objFSO.CopyFile objFile.Path, Target
17.  Next
18. End Sub
NT131 replied on 17-Oct-08 10:52 AM
I am really new to VBScripting, and I am looking for a Quick fix to my
situation. I have used the script below, and it works, but I noticed
that that I have multiple subfolders holding text files, and the script
only copies ONE level down.  Need to modify to copy multiple levels.


--
NT131
Al Dunbar replied on 17-Oct-08 02:05 PM
The script below where?

/Al