View Full Version : creating subfolders and saving files in them

12-03-2009, 02:44 AM
What Iíve got is an Input workbook with a lot of macros that gets new data everyday and uses it to create an Output workbook. So everyday I have new and updated Input and Output sheets. I need to archive these as they may be checked randomly at any point in the future.
So now what I need is a code in the Input sheet that creates a new folder and saves both the Input and Output files in that.

Lets say Iím doing all this in MyDocuments, in it a folder called 2009, in that another subfolder ĎDecemberí, in that I will have several folders named by date (eg. 02/12/09) with that dayís input and output files.

So its set up as Ė MyDocuments/2009/December/Ö.
Then when the month ends it should detect the new year and create another folder Ď2010í and subfolder ĎJanuaryí, then another folder named by the Date where the files will be saved.

I hope Iím being somewhat clear, if not please donít hesitate to ask. Iím just wondering whether it is possible to do this, would save a lot of time Ė otherwise Iíd have to manually create folders everyday to save the files.


12-03-2009, 02:58 AM
Just add some code that will create the directories on save. Like so

On Error Resume Next
MkDir "MyDocuments\" & Format(Date, "yyyy")
MkDir "MyDocuments\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")
MkDir "MyDocuments\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\" & Format(Date, "yy-mm-dd")
On Error Goto 0

12-03-2009, 03:41 AM
cool, thanks I'll try that and let you know

12-03-2009, 04:02 AM
It is a bit of an overhead for sure, but otherwise you would need to check the date, check if the folder already exists, and that would probably be just as much impact. Plus, you devolve the effort to the OS which is useful (as that code SJOULD be very efficient).

12-03-2009, 07:51 AM
Hey Xld,

I'm a bit confused, not sure where to place your code, I'm attaching a simplified file - the Input(Master.xls) and Output (Report.xls) files ---so you can get a better idea of what im trying to do....

The Master file is supposed to use data to create a new Report workbook with several sheets of graphs. Then the Report is attached to Outlook mailed out. Then the Report and Master files are saved into my harddrive in a newly created folder...C:\Archive\ .....

This is the code I'm working with, if you can please advise me on how to make the adjustment...thanks a lot!

Sub EmailandArchive()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim NewFilePath As String
Dim NewFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Set wb1 = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Open it/Mail it/Delete it

NewFilePath = Environ$("temp") & "\"
NewFileName = "Report" & " " & Format(Now, "dd-mmm-yy hh-mm-ss")
FileExtStr = "." & LCase(Right("Report", _
Len("Report") - InStrRev("Report", ".", , 1)))

wb1.SaveCopyAs NewFilePath & NewFileName & FileExtStr
' Creating Workbook and naming Sheet1 as AA, and using Data from MAster workbook Sheet "P" to make graph
Set wb2 = Workbooks.Open(NewFilePath & NewFileName & FileExtStr)
Sheets("Sheet1").Name = "AA"
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1"), PlotBy:= _
ActiveChart.SeriesCollection(1).XValues = "=[Master.xls]P!R2C1:R22C1"
ActiveChart.SeriesCollection(1).Values = "=[Master.xls]P!R2C2:R22C2"
ActiveChart.Location Where:=xlLocationAsObject, Name:="AA"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "SERIES"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveSheet.Shapes("Chart 1").IncrementLeft -134.25
ActiveSheet.Shapes("Chart 1").IncrementTop -85.5
ActiveWorkbook.SaveAs Filename:="C:\Archives\Report.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

'Use data in R to create graph, and name Sheet2 as BB
Sheets("Sheet2").Name = "BB"
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("MOL").Range("A3"), PlotBy:= _
ActiveChart.SeriesCollection(1).XValues = "=[Master.xls]R!R2C1:R22C1"
ActiveChart.SeriesCollection(1).Values = "=[Master.xls]R!R2C2:R22C2"
ActiveChart.Location Where:=xlLocationAsObject, Name:="MOL"
ActiveSheet.Shapes("Chart 1").IncrementLeft -134.25
ActiveSheet.Shapes("Chart 1").IncrementTop -85.5
ActiveWindow.Visible = False

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Daily Report"
.Body = ""
.Attachments.Add wb2.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

12-03-2009, 07:53 AM
here's the Input file

12-03-2009, 07:54 AM
here's the output file

12-03-2009, 07:58 AM
Just add before the SaveAs.