creating subfolders and saving files in them

[Anomandaris]

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.

Thanks

[Bob Phillips]

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

[Anomandaris]

cool, thanks I'll try that and let you know

[Bob Phillips]

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 SHOULD be very efficient).

[Anomandaris]

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)
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AA"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1"), PlotBy:= _
xlColumns
ActiveChart.SeriesCollection.NewSeries
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, _
CreateBackup:=False
'Use data in R to create graph, and name Sheet2 as BB
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "BB"
Range("A3").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("MOL").Range("A3"), PlotBy:= _
xlColumns
ActiveChart.SeriesCollection.NewSeries
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")
OutApp.Session.Logon
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

[Anomandaris]

here's the Input file

[Anomandaris]

here's the output file

[Bob Phillips]

Just add before the SaveAs.