Creating folders/subfolders using Macro

[Gaura215]

Hello

I have a spreadsheet with approximately 10 tabs with different names (001, 002, 003....etc).
I am require to create an individual workbook for each spreadsheet, and save it in the month folder which will be created in another folder with the value mentioned in A1 of the active spreadsheet.

So my file path will look something like "D:\SpreadsheetName\2011\Month Name\" Month folder to be in the format of "YYMM"

I am require to create this whole path mark in red. It means, 3 folder to be created one inside another, and saving the workbook in the last created folder.

The name of the folder is mentioned in Range A1 of all spreadsheets, and the month is mentioned in Z65536 in the format "yymm". In that month folder I need to save that workbook created with a fixed file name, "107" in this case.

I have so many reports in which I need to do the same procedure. So, a condition should be there in the macro to search for this path before creating the path.

Please suggest me a code using which I can do this without putting in so much of my manual efforts.

Thanks in advance to all Macro Gurus.

 

[Comfy]

Using your Example would the Path be:

D:\Range A1 Value\Current Year (or Financial Year, depending on your Company)\RangeZ65536 Value\Worksheet Name.xls

 

[Gaura215]

Using your Example would the Path be:

D:\Range A1 Value\Current Year (or Financial Year, depending on your Company)\RangeZ65536 Value\Worksheet Name.xls

Thanks a lot for the quick reply, however, I am stuck as my codes are not creating these subfolders. My codes are only making one of the folder. Below are the codes which I am currently having

Set objFso = CreateObject("Scripting.FileSystemObject")
strPath = "D:\Documents and Settings\g.khanna\Desktop\107 Report\"
For Each objSheet In ActiveWorkbook.Sheets
If Not objFso.FolderExists(strPath & objSheet.Name) Then
objFso.CreateFolder strPath & objSheet.Name
End If
Application.DisplayAlerts = False
Set objWorkbook = Application.Workbooks.Add
objSheet.Copy Before:=objWorkbook.Sheets(1)
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
ActiveWindow.SelectedSheets.Delete
objWorkbook.SaveAs strPath & objSheet.Name & "\" & "107"
objWorkbook.Close
Set objWorkbook = Nothing
Next
Application.DisplayAlerts = True

 

[Comfy]

You don't appear to be referencing Cells A1 and Z65536 in your code

which contain the criteria for the file path

 

[Gaura215]

Yes, I am unsure where to put that in.

 

[Gaura215]

Comfy, you correctly mentioned as my codes are not mentioning about it, reason being I am unsure if macro can make a whole path or not. So my macro are making only one folder and saving the workbook in them.

please advise.

 

[Comfy]

Sure, if you give me an Example of a Sheet

the Value in A1
the Value in Z65536
the Sheet Name

and the Desired output result

because at the moment you have specified two different outputs:

"D:\SpreadsheetName\2011\Month Name\"

and

strPath = "D:\Documents and Settings\g.khanna\Desktop\107 Report\"

 

[Gaura215]

ok sure, I will try to explain again.

The workbook has 10 different tabs.

I want all these tabs to be save as an individual workbook in the following path:-
"D:\Documents and Settings\g.khanna\Desktop\107 Report\"

In this path, I have folder till 107 Report, the remaining path has to be created.

So, if all goes well, the path should look like:-
"D:\Documents and Settings\g.khanna\Desktop\107 Report\Value in A1\2011\value in Z65536\spreadsheet"

1) Value in A1 is also the same which is the individual tabs name in the source workbook
2) Value in Z65536 is "=today()", folder should be created in the format YYMM, so for Jan, 2011, the folder should be created as 1101 followed by 1102 in february and so on.
3) spreadsheet name to be saved is fixed, "107" in this case.

Hope this is clear. Please let me know if there is any macro which can help me in making this.

 

[Darren Bartrup]

This code will build the folder structure:

'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'// Procedure : CreateFolder | Sub
'// Author    : DarkSprout
'// Purpose   : Will Recursively Build ADirectory Tree
'// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Folder <> "" Then
        If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
            Call CreateFolder(objFSO.GetParentFolderName(Folder))
        End If
        objFSO.CreateFolder (Folder)
    End If
End Sub

You can call it using:

CreateFolder "C:\My New Folder"
CreateFolder "H:\FirstFolder\SecondFolder\ThirdFolder\LastFolder"

You'll just have to build the text string using the values from your cells.

 

[Gaura215]

No idea, how this will work