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.

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







"mabright" wrote:

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.