Putting multiple .doc's together in many folders

[FMMonty]

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

 

[Jezebel]

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

 

[Jezebel]

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

 

[Jezebel]

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