Block saving using dates

[Guest]

I'm trying to make a macro that will save a workbook to 7 files, example, it
saves as 17 oct 04
18 oct 04
19 oct 04
and so on, so with one click i can create the next 7 days workbooks.
if someone can help it would be great.
Thankyou

 

[Sharad Naik]

See Code below

Sharad

Sub MultiSave()

Set fs = CreateObject("Scripting.FileSystemObject")
mypath = "c:\My Documents\"

If Not fs.FolderExists(mypath) Then
MsgBox "Folder " & mypath & " does not exist. Please create the folder
first."
'OR you can add code to create the folder.
Exit Sub
End If

dt = DatePart("d", Date)
mnth = DatePart("m", Date)
yr = DatePart("yyyy", Date)

Select Case mnth
Case 1
mnth = "Jan"
Case 2
mnth = "Feb"
Case 3
mnth = "Mar"
Case 4
mnth = "Apr"
Case 5
mnth = "May"
Case 6
mnth = "Jun"
Case 7
mnth = "Jul"
Case 8
mnth = "Aug"
Case 9
mnth = "Sep"
Case 10
mnth = "Oct"
Case 11
mnth = "Nov"
Case 12
mnth = "Dec"
End Select

allok = "yes"
For i = 0 To 6
spath = mypath & dt + i & " " & mnth & " " & yr & ".xls"
If fs.FileExists(spath) Then
MsgBox "File name " & spath & " already exists. Hence will not be
saved."
allok = "no"
GoTo 10
End If
ThisWorkbook.SaveAs spath
10 Next i
If allok = "yes" Then
MsgBox "All files saved successfully"
Else
MsgBox "Some (or all) files could not be saved."
End If

End Sub

 

[Dave Peterson]

Option Explicit
Sub testme()

Dim iCtr As Long
Dim FirstDate As Date

FirstDate = DateSerial(2004, 10, 16)
'or for today's date
FirstDate = Date

For iCtr = FirstDate To FirstDate + 6 '7 times
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\" _
& Format(iCtr, "dd mmm yy") & ".xls"
Next iCtr

End Sub

It uses the active workbook's path for the folder name.

And I like a format of:
& Format(iCtr, "yyyy_mm_dd") & ".xls"

Easier to sort on in windows explorer.

 

[Guest]

Thanks a lot guys this has helped me out no end, thanks again.