Putting multiple .doc's together in many folders

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

FMMonty - 15 Apr 2005 19:26 GMT

Our schools report generating software is a bit crazy in that it produces
folders for each subject and fills those folders with individual document
files for each pupil. Each subject has a folder, populated with sub folders,
so class 8X3 Science has 31 files in the 8X3 Science folder, which is in the
science folder. As such there is one heck of a lot of sub folders and files.

I need to write a macro that will put all of the files in each folder
together into one word document. I've managed to do this for a single
folder, but I'd have to change and run the macro repeatedly which would drive
the admin staff crazy.

Does anyone have any suggestions for how I could run a single macro on the
top reports folder, which would search each subfolder, and put all of the
individual reports into a single word document, preferably named after the
folder name?

I'm not even sure that this is possible, but I do know that it is way above
me.

Any hints or suggestions would be greatly appreciated.

BKS

Reply to this Message

Jezebel - 16 Apr 2005 07:11 GMT

Start with your single-folder macro. Modify it so that the name of the
folder is passed as an argument, instead of being written in as part of the
code ...

Sub DoFolder (FolderName as string)
....

Now write a second macro that reads the contents of the root folder, looking
for folder names. Each time it finds one, it calls the DoFolder macro.

Dim pFolderName As String
Dim pRootFolder As String

pRootFolder = "C:\Documents and Settings\....\"

pFolderName = Dir(pRootFolder & "*.", vbDirectory)
Do Until Len(pFolderName) = 0
DoFolder pRootFolder & pFolderName
pFolderName = Dir
Loop

> Our schools report generating software is a bit crazy in that it produces
> folders for each subject and fills those folders with individual document
[quoted text clipped - 23 lines]
>
> BKS

Reply to this Message

FMMonty - 16 Apr 2005 14:15 GMT

Thanks Jezebel, that has really helped.

I can now combine everything in a top folder (such as Test), and in folders
1 level below. However if there are folders 2 levels below they are ignored.
ie

Test
Test1a Test1b

Test2a Test2b Test2c Test2d

The test and test 1 series work, the test 2 series don't. Should I shuffle
the folders around, or is there an easy workaround for this? My full code so
far is added below. (Embarisingly I'm also unable to name the files after
the folder they are in, such as naming the combined file in folder Test1b as
Test1b).

Being a complete beginner has a number of problems :)

BKS

Sub DoFolder(FolderName As String)
Dim i As Long
Application.ScreenUpdating = False
Documents.Add
With Application.FileSearch

'Search in foldername
.LookIn = FolderName

.SearchSubFolders = False
.FileName = "*.doc"
.Execute
For i = 1 To .FoundFiles.Count
Selection.InsertFile FileName:=(.FoundFiles(i)), _
ConfirmConversions:=False, Link:=False, Attachment:=False
Next i

End With
ChangeFileOpenDirectory (FolderName)
ActiveDocument.SaveAs FileName:="full", FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True,
WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False,
SaveAsAOCELetter:= _
False
ActiveWindow.Close
End Sub

Sub FolderCount()
'
'
Dim pFolderName As String
Dim pRootFolder As String
pRootFolder = "C:\Test\"
pFolderName = Dir(pRootFolder & "*.", vbDirectory)

Do Until Len(pFolderName) = 0
DoFolder pRootFolder & pFolderName
pFolderName = Dir
Loop

End Sub

Reply to this Message

Jezebel - 17 Apr 2005 02:17 GMT

To deal with sub-sub-folder, to any depth, you need to call your function
recursively --

'Master function --- this is where you start. All it does is set the
top-level folder
Sub MasterSub()
FolderCount "C:\Test\"
End Sub

Sub FolderCount(RootFolder as string)

Dim pFolderName As String

'Do the files in this folder
DoFolder RootFolder & pFolderName

'Do any sub-folders by calling this same function recursively
pFolderName = Dir(RootFolder & "*.", vbDirectory)

Do Until Len(pFolderName) = 0
FolderCount RootFolder & pFolderName
pFolderName = Dir
Loop

End Sub

To name the file after the folder, use something like

Dim pFileName as string

pFileName = FolderName & ".doc"
ActiveDocument.SaveAs FileName:=pFileName

> Thanks Jezebel, that has really helped.
>
[quoted text clipped - 50 lines]
> ActiveWindow.Close
> End Sub

Reply to this Message

Jezebel - 17 Apr 2005 03:19 GMT

Just realised there's a bug in that code I posted. You can't use Dir()
recursively. Should be something like ..

'Master function --- this is where you start. All it does is set the
top-level folder
Sub MasterSub()
FolderCount "C:\Test\"
End Sub

Sub FolderCount(RootFolder as string)

Dim pFolderName As String
Dim pCollection as collection
Dim pDir as variant

'Do the files in this folder
DoFolder RootFolder & pFolderName

'Create collection of sub-folders
set pCollection = new collection
pFolderName = Dir(RootFolder & "*.", vbDirectory)

Do Until Len(pFolderName) = 0
pCollection.Add RootFolder & pFolderName
pFolderName = Dir
Loop

'Process each sub-folder
For each pDir in pCollection
FolderCount pDir
Next

End Sub

To name the file after the folder, use something like

Dim pFileName as string

pFileName = FolderName & ".doc"
ActiveDocument.SaveAs FileName:=pFileName

> Thanks Jezebel, that has really helped.
>
[quoted text clipped - 65 lines]
>
> End Sub

Reply to this Message