Transfer similar files into folder

[saybut]

Hi,

I have a problem at the moment, very grateful if anyone can assist.

I started of with a word document which I cut up into relevan
chapters, 7 chapters = 7 new documents. The orignal was calle
OHEC2828. The new 7 new documents are called OHEC2828a, OHEC2828b
OHEC2828c, etc.

I then ran a macro in word to open the the new documents one at a tim
and save then as .htm files. When MS Word saves the files as .htm i
creates a folder for each document with any gifs, headers, footers an
xml files in there.

I basically end up with 7 htm files and 7 corresponding folders.

My aim is to be able to copy the contents out of the 7 folders an
place them in one single folder, and at the same time, copy th
corresponding htm files and place them in the folder too.

The folders which are created by word are have the same name as th
documents, but with _files added to the end of the folder name.

It looks like:

OHME1350a_files (folder)
OHME1350b_files (folder)
OHME1350c_files (folder)
OHME1350d_files (folder)
OHME1350e_files (folder)

OHME1350a.htm (file)
OHME1350b.htm (file)
OHME1350c.htm (file)
OHME1350d.htm (file)
OHME1350e.htm (file)

Looks like finished:

OHME1350 (Folder)
|
--> all files from folders & htm files. (inside folder)

I have to do this for around 400 documents.

I'm sorry if the above is a bit of a mess, I tried to explain it th
best I could but it its fairly hard to explain.

I am working on a couple of screenshots now, I will hopefully post on
this afternoon.

any help would be greatly appreciated.

Regards,

Mark.

ps. If you have any questions feel free to email me
(e-mail address removed)

 

[Dave Peterson]

I'm not quite sure I understand, but this'll copy subfolders that end with
_files and files that end with .htm into a common folder.


Option Explicit
Sub testme()

Dim FinalFolderName As String
Dim CurrentFolderName As String

Dim FSO As Scripting.FileSystemObject

Dim FinalFolder As Scripting.Folder
Dim CurrentFolder As Scripting.Folder
Dim myFolder As Scripting.Folder
Dim myFile As Scripting.File

FinalFolderName = "C:\temp"
CurrentFolderName = "C:\test"

Set FSO = New Scripting.FileSystemObject

If FSO.FolderExists(CurrentFolderName) = False _
Or FSO.FolderExists(FinalFolderName) = False Then
MsgBox "where are they???"
Exit Sub
End If

Set CurrentFolder = FSO.GetFolder(CurrentFolderName)
Set FinalFolder = FSO.GetFolder(FinalFolderName)

For Each myFolder In CurrentFolder.SubFolders
If LCase(Right(myFolder.Name, 6)) = "_files" Then
FSO.CopyFolder Source:=myFolder, _
Destination:=FinalFolder
End If
Next myFolder

For Each myFile In CurrentFolder.Files
If LCase(Right(myFile.Name, 4)) = ".htm" Then
myFile.Copy Destination:=FinalFolder.Path & "\" & myFile.Name, _
overwritefiles:=True
End If
Next myFile

End Sub

This code requires a reference to the "Microsoft Scripting Runtime"
(tools|References inside the VBE).

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm