Moving files into folders

[drm930]

I am trying to move some files around and rename them, my files are specifically;

SUB_DOMAIN
index.htm

SUB_FOLDER1
index.htm

SUB_FOLDER2
index.htm

SUB_FOLDER3
index.htm

SUB_FOLDER4
index.htm

SUB_FOLDER5
index.htm

SUB_FOLDER6
index.htm

There are hundreds of SUB_DOMAINS all different city names - what I am trying to do is find a program that will place htm files with "matching" city names in the apporiate SUB_DOMAIN folder.

That part would be "if file name matches folder name move to folder name". BUT at that point I also want it to create a SUB_FOLDER (that I can specify the name) so it would be;

If .html file name matches SUB_DOMAIN folder name, then create SUB_FOLDER called #ANY-NAME-I-WANT# and place matching .html file of the SUB_DOMAIN folder into that newly created #ANY-NAME-I-WANT# folder and then rename the .html file to index.

 

[PHV]

What have YOU tried so far and where in YOUR code are you stuck ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[drm930]

Right now I just have a script that will create a SUB DOMAIN folder based on the .html file but really at a loss from there.

Dim fso
Dim Folders
Dim CurrentFolder
Dim Files
Dim NewFolderName
Dim TruncatedFileName

Set fso = CreateObject("Scripting.FileSystemObject")
Set MainFolder = fso.GetFolder(".")
ProcessFolder MainFolder

Sub ProcessFolder(CurrentFolder)
Set Folders = CurrentFolder.SubFolders

' Folders first, then files
For Each Folder in Folders
ProcessFolder(Folder)
Next

Set Files = CurrentFolder.Files
For Each File in Files
If UCase(Right(File.Name,3)) <> "VBS" Then
TruncatedFileName = Left(File.Name, InstrRev(File.Name, ".") - 1)
NewFolderName = CurrentFolder.Path & "\" & TruncatedFilename

fso.CreateFolder NewFolderName
File.Move NewFolderName & "\"

End If
Next
End Sub