HOW DO I USE EXCEL TO CREATE FILEs AND FOLDERS FROM A TEMPLATE?

M

mabright

I have a folder structure with template files in the folders. I want to
create a named folder (based on a sequential number), all subfolders and
copies of the template files with the same suffix that the top level folder
has (in this case, a -xxx number). I want to do this from a command within
excel, then create a new column based on the new folders (with contract
number/name/filename) and set hyperlinked cells within the new column to the
newly created files. I would also like to password protect the macro/command
to ensure it cannot be accessed accidentally.

Any help greatly appreciated.
 
J

joel

See if this works. I modified some previously written macro(s). You need to
change the BaseFolder (root file where template is located and where new
folder will be created), TemplateFolder (you template directory), and the New
Column letter. the code searches all sub-directories in the Basefolder.

Sub Copyfolder()

Basefolder = "C:\Temp"
TemplateFolder = "Test"

Set FSO = CreateObject _
("Scripting.FileSystemObject")

MyNumber = InputBox("Enter a New Contract Number")
NewFolderName = Basefolder & "\" & TemplateFolder & "-" & MyNumber

FSO.Copyfolder _
Basefolder & "\" & TemplateFolder, NewFolderName

RowCount = 1
NewColumn = "A"
'rename all files and folders
Call GetSubFolder(NewFolderName + "\", MyNumber, NewColumn, RowCount)
End Sub

Sub GetSubFolder(strFolder, MyNumber, NewColumn, ByRef RowCount)
Set FSO = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
FSO.GetFolder(strFolder)

If Folder.subfolders.Count > 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call GetSubFolder(strFolder + sf.Name + "\", _
MyNumber, NewColumn, RowCount)
ParentFld = FSO.GetParentFolderName(Folder)
NewName = strFolder & sf.Name & "-" & MyNumber
FSO.MoveFolder sf, NewName
Range(NewColumn & RowCount) = NewName
Range(NewColumn & RowCount).Hyperlinks.Add _
Anchor:=Range(NewColumn & RowCount), _
Address:=NewName, _
TextToDisplay:=NewName
RowCount = RowCount + 1
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files

Base = FSO.getbasename(fl)
NewName = Folder & "/" & Base & "-" & _
MyNumber & "." & FSO.getextensionname(fl)

FSO.MoveFile fl, NewName
Range(NewColumn & RowCount) = NewName
Range(NewColumn & RowCount).Hyperlinks.Add _
Anchor:=Range(NewColumn & RowCount), _
Address:=NewName, _
TextToDisplay:=NewName
RowCount = RowCount + 1

Next fl

200 On Error GoTo 0

End Sub
 
Joined
Mar 26, 2009
Messages
2
Reaction score
0
Joel, you are obviously a wizard. This works brilliantly, but to my own shame I think I have given you duff info (not unknown for me). The program does exactly what I said on the tin, but I'll need to quiz you a bit more (if you're up for some tutoring?) to tweak it to get the exact results that I was thinking of (and obviously not portraying very well). I'll go through it and try to understand what each bit does (I've done a bit of programming before), then see if I can come up with some more pertinent questions to finish it off.

Thanks a million.

Mark
 
Joined
Mar 26, 2009
Messages
2
Reaction score
0
Just a quick question - Is it possibe to get a (seperate) macro to find all of the pdf's stored in the created directories and print them? This is for project documentation, and the ability to do a one stop print function would be of great benefit when the project is complete.

Thanks
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top