Create 52 folders one for each week of the year?

Sumeluar

Active Member
Joined
Jun 21, 2006
Messages
266
Office Version
  1. 365
  2. 2016
  3. 2010
Platform
  1. Windows
  2. MacOS
  3. Mobile
Good day to all!

I'm in trouble, My knowledge is limited and I don't know how to tackle this one, Here it goes:

I have a daily sheet [Template] which is used numerous times during the day, it gets saved with the chosen name-date-time and printed to the specified printer and folder, That's all good the problem is I don't know how to create 52 folders, one for each week of the year, so that a macro chooses the right folder [meaning for the current week] and sent it there.

Any thoughts appreciated.

Kind Regards!

Sumeluar
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi -
you can start with this code, this will create 52 folders in driveC, named WeekNum1,WeekNum2, etc...
Code:
Sub sample()
Dim i As Long
For i = 1 To 52
MkDir "c:\WeekNum" & i
Next
End Sub
 
Upvote 0
Thanks agihcam for your response, That piece surely created the 52 folders I'm looking for, but I'd like to add a piece of code that if the folder with the current week number already exists it simply goes to the the next step, which in this case would be to save the file to the current week.

Kind Regards!

Sumeluar
 
Upvote 0
Hi
change to
Code:
Sub sample()
Dim i As Long, myFolder As String
myFolder = "c:\WeekNum"
For i = 1 To 52
   If Dir(myFolder & i, vbDirectory) = "" Then MkDir myFolder & i
Next
End Sub
 
Upvote 0
jindon, that's good. Now how do I direct a workbook to choose the current week?

Kind regards!

Sumeluar
 
Upvote 0
jindon, that's good. Now how do I direct a workbook to choose the current week?

Kind regards!

Sumeluar

Where is the date for the file and how ist it formatted?
 
Upvote 0
How about something like this:

Somewhere in your workbook (any sheet, any cell).

For my example
I'll use a sheet named "SaveIt".
Within this sheet, cells A1-A5

A1 type:
=today()

A2 type:
=weeknum(A1,1)

A3 type:
="week " & A2 & ".xls"

A4 type:
="weeknum" & A2

A5 type:
="C:\" & A4 & "\" & A3

So, today is 04 October 2006. This is the 40th week in the year 2006. Tomorrow, 05 is also in the 40th week, so the value won't change. When the date is 09 October 2006 (Monday), it will be the 41st week.

This value will always be the current week. If you want to save as a different week, do a Save As, or change the date in cell A1.

A3 will read: week 40.xls
A4 will read: weeknum40
A5 will read: C:\weeknum40\week 40.xls

Now, put the following code into some button you will click to save your workbook.

Code:
ActiveWorkbook.SaveAs Filename:=Sheets("SaveIt").Range("A5"), FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

This code is a supplement to Jindon's code. First use his code to create the folder, then use this code to create the filename. The folder must first be created.

The only problem would be if for some reason your workbook wasn't opened for a week. The sheet code (SaveIt) is "Live" and will change with the current week. Jindon's code will create the 'next greater' folder. So, if you miss week34 your worksheet will be saved week35, but your folder's name will be week34.

A work around to this would be to change the code to include creating the folder as well.

Example:

Code:
If Dir("C:\" & Sheets("SaveIt").Range("A4"), vbDirectory) = "" Then
        MkDir "C:\" & Sheets("SaveIt").Range("A4")
        End If

ActiveWorkbook.SaveAs Filename:=Sheets("SaveIt").Range("A5"), FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

Now just create a autoshape button and put this code in the autoshapes macro, then when the user clicks it, it will save automatically.

Hope this helps :)
TeacherEric
 
Upvote 0
something like this?
Code:
Sub sample()
Dim i As Integer, myFolder As String, myWeekNum As Integer
myWeekNum = CInt(Format(Date,"ww",2))
myFolder = "c:\WeekNum" & myWeekNum
If Dir(myFolder, vbDirectory) = "" Then MkDir myFolder
Application.DisplayAlerts = False
ThisWorkbook.SaveAs myFolder & "\" & ThisWorkbook.Name, FileFormat:=xlNormal
Application.DisplayAlerts = True
End Sub
 
Upvote 0
something like this?
Code:
Sub sample()
Dim i As Integer, myFolder As String, myWeekNum As Integer
myWeekNum = CInt(Format(Date,"ww",2))
myFolder = "c:\WeekNum" & myWeekNum
If Dir(myFolder, vbDirectory) = "" Then MkDir myFolder
Application.DisplayAlerts = False
ThisWorkbook.SaveAs myFolder & "\" & ThisWorkbook.Name, FileFormat:=xlNormal
Application.displayAlerts = True
End Sub

This is wonderful jindon! :LOL:

I think it's helped me with my currnet issue as well...

One questions for you jindon. When I applied your code, it saves as week 41 not week 40. October 1st - 7th is the 40th week of the year 2006, even using the ISO rule.
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,993
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top